Changeset 1991


Ignore:
Timestamp:
2010-07-08T15:39:26+02:00 (10 years ago)
Author:
smasson
Message:

Load working_directory into vendors/IOIPSL/current.

Location:
vendors/IOIPSL/current
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • vendors/IOIPSL/current/example/testflio.f90

    r1895 r1991  
    11PROGRAM testflio 
    22!- 
    3 !$Id: testflio.f90 386 2008-09-04 08:38:48Z bellier $ 
     3!$Id: testflio.f90 887 2010-02-08 09:48:39Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    106106  CALL fliodefv (fid,'my_var_1',(/ 5 /), & 
    107107 &               v_t=flio_r4,units='1',long_name='my_var_1', & 
    108  &               valid_min=-10.,valid_max=+20.) 
     108 &               valid_min=-10.,valid_max=+20.,fillvalue=+50.) 
    109109  CALL fliodefv (fid,'Var_vr4', & 
    110110 &               v_t=flio_r4,units='1',long_name='Var_vr4') 
  • vendors/IOIPSL/current/example/testhist1.f90

    r1895 r1991  
    11PROGRAM testhist1 
    22!- 
    3 !$Id: testhist1.f90 386 2008-09-04 08:38:48Z bellier $ 
     3!$Id: testhist1.f90 807 2009-11-23 12:11:55Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    7272  CALL histdef (id,"champ1","Some field","m", & 
    7373 &       iim,jjm,hori_id,1,1,1,-99,32,"inst(scatter(x))", & 
    74  &       dt_op,dt_wrt,var_range=(/1.,-1./)) 
     74 &       dt_op,dt_wrt,var_range=(/1.,-1./),standard_name='thickness') 
    7575!- 
    7676  CALL histdef (id,"champ2","Another field","m", & 
    7777 &       iim,jjm,hori_id,llm,1,llm,sig_id,32,"t_max(max(x,1.0)*2)", & 
    78  &       deltat,dt_wrt,var_range=(/0.,90./)) 
     78 &       deltat,dt_wrt,var_range=(/0.,90./),standard_name='thickness') 
    7979!- 
    8080  CALL histdef (id,"champ3","A field without time","m", & 
    8181 &       iim,jjm,hori_id,1,1,1,-99, 32,"once", & 
    82  &       deltat,dt_wrt) 
     82 &       deltat,dt_wrt,standard_name='thickness') 
    8383!- 
    8484  CALL histend (id) 
  • vendors/IOIPSL/current/example/testhist2.f90

    r1895 r1991  
    11PROGRAM testhist2 
    22!- 
    3 !$Id: testhist2.f90 386 2008-09-04 08:38:48Z bellier $ 
     3!$Id: testhist2.f90 807 2009-11-23 12:11:55Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    7676  CALL histvert (id,"sigma","Sigma levels"," ",llm,lev,sig_id,pdirect="up") 
    7777!- 
    78   CALL histdef (id,"champ1","Some field","m", & 
    79  &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op,dt_wrt) 
     78  CALL histdef (id,"champ1","Some field","m",iim,jjm,hori_id, & 
     79 &  1,1,1,-99,32,"t_sum",dt_op,dt_wrt,standard_name='thickness') 
    8080!- 
    81   CALL histdef (id,"champ2","summed field","m", & 
    82  &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op,dt_wrt) 
     81  CALL histdef (id,"champ2","summed field","m",iim,jjm,hori_id, & 
     82 &  1,1,1,-99,32,"t_sum",dt_op,dt_wrt,standard_name='thickness') 
    8383!- 
    8484  CALL histend (id) 
     
    9292  CALL histvert (id2,"sigma","Sigma levels"," ",llm,lev,sig_id,pdirect="up") 
    9393!- 
    94   CALL histdef (id2,"champ1","Some field","m", & 
    95  &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2) 
     94  CALL histdef (id2,"champ1","Some field","m",iim,jjm,hori_id, & 
     95 &  1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2,standard_name='thickness') 
    9696!- 
    97   CALL histdef (id2,"champ2","summed field","m", & 
    98  &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2) 
     97  CALL histdef (id2,"champ2","summed field","m",iim,jjm,hori_id, & 
     98 &  1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2,standard_name='thickness') 
    9999!- 
    100100  CALL histend (id2) 
  • vendors/IOIPSL/current/example/testopp.f90

    r1895 r1991  
    11PROGRAM testopp 
    22!- 
    3 !$Id: testopp.f90 386 2008-09-04 08:38:48Z bellier $ 
     3!$Id: testopp.f90 846 2009-12-10 16:26:58Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    3434     WRITE(*,*) ' ' 
    3535     WRITE(*,*) 'String to be analyzed : ',TRIM(opp) 
    36      CALL buildop (opp,ex_topps,tmp_topp,nbopp_max,missing_val, & 
    37     &              tmp_sopp,tmp_scal,nbopp) 
     36     CALL buildop (TRIM(opp),ex_topps,tmp_topp,missing_val, & 
     37 &                 tmp_sopp,tmp_scal,nbopp) 
    3838!- 
    39      WRITE(*,*) 'Time operation : ',TRIM(tmp_topp) 
    40      WRITE(*,*) 'Other operations  :', nbopp 
     39     WRITE(*,*) 'Time operation   : ',TRIM(tmp_topp) 
     40     WRITE(*,*) 'Other operations : ',nbopp 
    4141     DO i=1,nbopp 
    42        WRITE(*,*) 'i = ',i,' opp : ',tmp_sopp(i), & 
    43       &           ' scalar : ',tmp_scal(i) 
     42       WRITE(*,*) ' ',i,' opp : ',tmp_sopp(i),' scalar : ',tmp_scal(i) 
    4443     ENDDO 
    4544   ENDDO 
  • vendors/IOIPSL/current/src/calendar.f90

    r1895 r1991  
    11MODULE calendar 
    22!- 
    3 !$Id: calendar.f90 693 2009-07-29 15:49:31Z bellier $ 
     3!$Id: calendar.f90 1011 2010-05-07 13:05:34Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    511511!- action is smaller than the one from the next expected 
    512512!- check to the next action. 
    513 !- When the test is done on the time steps simplifactions make 
     513!- When the test is done on the time steps simplifications make 
    514514!- it more difficult to read in the code. 
    515515!- For the real time case it is easier to understand ! 
  • vendors/IOIPSL/current/src/errioipsl.f90

    r1895 r1991  
    11MODULE errioipsl 
    22!- 
    3 !$Id: errioipsl.f90 386 2008-09-04 08:38:48Z bellier $ 
     3!$Id: errioipsl.f90 759 2009-10-22 08:53:27Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    8080   ENDIF 
    8181   IF ( (plev == 3).AND.lact_mode) THEN 
    82      STOP 'Fatal error from IOIPSL. See stdout for more details' 
     82     WRITE(n_l,'("Fatal error from IOIPSL. STOP in ipslerr with code")') 
     83     STOP 1 
    8384   ENDIF 
    8485!--------------------- 
  • vendors/IOIPSL/current/src/fliocom.f90

    r1895 r1991  
    11MODULE fliocom 
    22!- 
    3 !$Id: fliocom.f90 386 2008-09-04 08:38:48Z bellier $ 
     3!$Id: fliocom.f90 965 2010-04-07 08:38:54Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    1212 &                    ioconf_calendar,ju2ymds,ymds2ju 
    1313USE errioipsl, ONLY : ipslerr,ipsldbg 
    14 USE stringop,  ONLY : strlowercase 
     14USE stringop,  ONLY : strlowercase,str_xfw 
    1515!- 
    1616IMPLICIT NONE 
     
    8686!!              This argument can be equal to FLIO_DOM_DEFAULT 
    8787!!              (see "flio_dom_defset"). 
    88 !! (C) mode   : Mode used to create the file. 
    89 !!              Supported modes : REPLACE, REP, 32, 64, REP32, REP64. 
    90 !!              If this argument is present with the value "REP[32/64]" 
    91 !!              or the value "REPLACE", the file will be created 
    92 !!              in mode "CLOBBER", else the file will be created 
    93 !!              in mode "NOCLOBBER". 
     88!! (C) mode   : String of (case insensitive) blank-separated words 
     89!!              defining the mode used to create the file. 
     90!!              Supported keywords : REPLACE, 32, 64 
     91!!              If this argument is present with the keyword "REPLACE", 
     92!!              the file will be created in mode "CLOBBER", 
     93!!              else the file will be created in mode "NOCLOBBER". 
    9494!!              "32/64" defines the offset mode. 
    95 !!              The default offset mode is 32 bits. 
     95!!              The default offset mode is 64 bits. 
     96!!              Keywords "NETCDF4" and "CLASSIC" are reserved 
     97!!              for future use. 
    9698!! 
    9799!! Optional OUTPUT arguments 
     
    205207!! SUBROUTINE fliodefv & 
    206208!! & (f_i,v_n,[v_d],v_t, & 
    207 !! &  axis,standard_name,long_name,units,valid_min,valid_max) 
     209!! &  axis,standard_name,long_name,units, & 
     210!! &  valid_min,valid_max,fillvalue) 
    208211!! 
    209212!! INPUT 
     
    227230!! (C) axis,standard_name,long_name,units : Attributes 
    228231!!     (axis should be used only for coordinates) 
    229 !! (R) valid_min,valid_max : Attributes 
     232!! (R) valid_min,valid_max,fillvalue : Attributes 
    230233!!-------------------------------------------------------------------- 
    231234  MODULE PROCEDURE & 
     
    805808!- 
    806809! Maximum number of simultaneously defined domains 
    807   INTEGER,PARAMETER :: dom_max_nb=10 
     810  INTEGER,PARAMETER :: dom_max_nb=64 
    808811!- 
    809812! Maximum number of distributed dimensions for each domain 
     
    848851  INTEGER :: i_rc,f_e,idid,ii,m_c,n_u 
    849852  CHARACTER(LEN=NF90_MAX_NAME) :: f_nw 
     853  INTEGER,PARAMETER :: l_string=80,l_word=10 
     854  CHARACTER(LEN=l_string) :: c_string 
     855  CHARACTER(LEN=l_word)   :: c_word 
     856  LOGICAL :: l_ok 
     857  INTEGER,PARAMETER :: k_replace=1 
     858  INTEGER,PARAMETER :: k_32=1,k_64=2 
     859!- !? : Code to be activated for NETCDF4 
     860!?  INTEGER,PARAMETER :: k_netcdf4=1,k_classic=1 
     861  INTEGER,PARAMETER :: n_opt=4 
     862  INTEGER,DIMENSION(n_opt) :: i_opt 
    850863!- 
    851864  LOGICAL :: l_dbg 
     
    881894!- 
    882895! Check the mode 
     896!- 
     897  i_opt(:)=-1 
     898!- 
    883899  IF (PRESENT(mode)) THEN 
    884     SELECT CASE (TRIM(mode)) 
    885     CASE('REPLACE','REP','REP32') 
    886       m_c = NF90_CLOBBER 
    887     CASE('32') 
    888       m_c = NF90_NOCLOBBER 
    889     CASE('64') 
    890       m_c = IOR(NF90_NOCLOBBER,NF90_64BIT_OFFSET) 
    891     CASE('REP64') 
    892       m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET) 
    893     CASE DEFAULT 
    894       m_c = NF90_NOCLOBBER 
    895     END SELECT 
     900!--- 
     901    IF (LEN_TRIM(mode) > l_string) THEN 
     902      CALL ipslerr (3,'fliocrfd', & 
     903 &     '"mode" argument','too long','to be treated') 
     904    ENDIF 
     905    c_string = mode(:) 
     906    CALL strlowercase (c_string) 
     907!--- 
     908    DO 
     909      CALL str_xfw  (c_string,c_word,l_ok) 
     910      IF (l_ok) THEN 
     911!- !? : Code to be activated for NETCDF4 
     912        SELECT CASE (TRIM(c_word)) 
     913        CASE('replace') 
     914          IF (i_opt(1) > 0) THEN 
     915            CALL ipslerr (3,'fliocrfd', & 
     916 &           'Replace option','already','defined') 
     917          ELSE 
     918            i_opt(1) = k_replace 
     919          ENDIF 
     920!?      CASE('netcdf4') 
     921!?        IF (i_opt(2) > 0) THEN 
     922!?          CALL ipslerr (3,'fliocrfd', & 
     923!? &         'Netcdf4 format','already','defined') 
     924!?        ELSE 
     925!?          i_opt(2) = k_netcdf4 
     926!?        ENDIF 
     927        CASE('32') 
     928          IF (i_opt(3) > 0) THEN 
     929            CALL ipslerr (3,'fliocrfd', & 
     930 &           'Offset format','already','defined') 
     931          ELSE 
     932            i_opt(3) = k_32 
     933          ENDIF 
     934        CASE('64') 
     935          IF (i_opt(3) > 0) THEN 
     936            CALL ipslerr (3,'fliocrfd', & 
     937 &           'Offset format','already','defined') 
     938          ELSE 
     939            i_opt(3) = k_64 
     940          ENDIF 
     941!?      CASE('CLASSIC') 
     942!?        IF (i_opt(4) > 0) THEN 
     943!?          CALL ipslerr (3,'fliocrfd', & 
     944!? &         'Netcdf4 classic format','already','defined') 
     945!?        ELSE 
     946!?          i_opt(4) = k_classic 
     947!?        ENDIF 
     948        CASE DEFAULT 
     949          CALL ipslerr (3,'fliocrfd', & 
     950 &         'Option '//TRIM(c_word),'not','supported') 
     951        END SELECT 
     952      ELSE 
     953        EXIT 
     954      ENDIF 
     955    ENDDO 
     956  ENDIF 
     957!- 
     958  IF (i_opt(1) == k_replace) THEN 
     959    m_c = NF90_CLOBBER 
    896960  ELSE 
    897961    m_c = NF90_NOCLOBBER 
    898962  ENDIF 
     963!- 
     964!- Code to be replaced by the following for NETCDF4 
     965!?  IF (i_opt(2) == k_netcdf4) THEN 
     966!?    m_c = IOR(m_c,NF90_NETCDF4) 
     967!?    IF (i_opt(3) > 0) THEN 
     968!?      CALL ipslerr (3,'fliocrfd', & 
     969!? &     'Netcdf4 format','and offset option','are not compatible') 
     970!?    ELSE IF (i_opt(4) == k_classic) THEN 
     971!?      m_c = IOR(m_c,NF90_CLASSIC_MODEL) 
     972!?    ENDIF 
     973!?   LSE IF (i_opt(4) > 0) THEN 
     974!?    CALL ipslerr (3,'fliocrfd', & 
     975!? &   'Classic option','is reserved','for the Netcdf4 format') 
     976!?  ELSE 
     977    IF (i_opt(3) /= k_32) THEN 
     978      m_c = IOR(m_c,NF90_64BIT_OFFSET) 
     979    ENDIF 
     980!?  ENDIF 
    899981!- 
    900982! Create file (and enter the definition mode) 
     
    12291311! Ensuring data mode 
    12301312!- 
    1231     CALL flio_hdm (f_i,f_e,.FALSE.) 
     1313  CALL flio_hdm (f_i,f_e,.FALSE.) 
    12321314!- 
    12331315! Create the longitude axis 
     
    12871369SUBROUTINE fliodv_r0d & 
    12881370 & (f_i,v_n,v_t, & 
    1289  &  axis,standard_name,long_name,units,valid_min,valid_max) 
     1371 &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue) 
    12901372!--------------------------------------------------------------------- 
    12911373  IMPLICIT NONE 
     
    12961378  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: & 
    12971379 & axis,standard_name,long_name,units 
    1298   REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max 
     1380  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue 
    12991381!--------------------------------------------------------------------- 
    13001382  CALL flio_udv & 
    13011383 &  (f_i,0,v_n,(/0/),v_t, & 
    1302  &   axis,standard_name,long_name,units,valid_min,valid_max) 
     1384 &   axis,standard_name,long_name,units,valid_min,valid_max,fillvalue) 
    13031385!------------------------ 
    13041386END SUBROUTINE fliodv_r0d 
     
    13061388SUBROUTINE fliodv_rnd & 
    13071389 & (f_i,v_n,v_d,v_t, & 
    1308  &  axis,standard_name,long_name,units,valid_min,valid_max) 
     1390 &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue) 
    13091391!--------------------------------------------------------------------- 
    13101392  IMPLICIT NONE 
     
    13161398  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: & 
    13171399 & axis,standard_name,long_name,units 
    1318   REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max 
     1400  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue 
    13191401!--------------------------------------------------------------------- 
    13201402  CALL flio_udv & 
    13211403 &  (f_i,SIZE(v_d),v_n,v_d,v_t, & 
    1322  &   axis,standard_name,long_name,units,valid_min,valid_max) 
     1404 &   axis,standard_name,long_name,units,valid_min,valid_max,fillvalue) 
    13231405!------------------------ 
    13241406END SUBROUTINE fliodv_rnd 
     
    13261408SUBROUTINE flio_udv & 
    13271409 & (f_i,n_d,v_n,v_d,v_t, & 
    1328  &  axis,standard_name,long_name,units,valid_min,valid_max) 
     1410 &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue) 
    13291411!--------------------------------------------------------------------- 
    13301412  IMPLICIT NONE 
     
    13361418  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: & 
    13371419 & axis,standard_name,long_name,units 
    1338   REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max 
     1420  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue 
    13391421!- 
    13401422  INTEGER :: f_e,m_k,i_v,i_rc,ii,idd 
     
    13801462!--- 
    13811463    IF (PRESENT(v_t)) THEN 
    1382       IF      (v_t == flio_i) THEN 
     1464      SELECT CASE (v_t) 
     1465      CASE(flio_i) 
    13831466        IF (i_std == i_8) THEN 
    1384 !-------- Not yet supported by NETCDF 
     1467!-------- I8 not yet supported by NETCDF 
    13851468!-------- m_k = flio_i8 
    13861469          m_k = flio_i4 
     
    13881471          m_k = flio_i4 
    13891472        ENDIF 
    1390       ELSE IF (v_t == flio_r) THEN 
     1473      CASE(flio_r) 
    13911474        IF (r_std == r_8) THEN 
    13921475          m_k = flio_r8 
     
    13941477          m_k = flio_r4 
    13951478        ENDIF 
    1396       ELSE 
     1479      CASE(flio_c,flio_i1,flio_i2,flio_i4,flio_r4,flio_r8) 
    13971480        m_k = v_t 
    1398       ENDIF 
     1481      CASE DEFAULT 
     1482        CALL ipslerr (3,'fliodefv', & 
     1483 &        'Variable '//TRIM(v_n),'External type','not supported') 
     1484      END SELECT 
    13991485    ELSE IF (r_std == r_8) THEN 
    14001486      m_k = flio_r8 
     
    14021488      m_k = flio_r4 
    14031489    ENDIF 
     1490!--- 
    14041491    IF (n_d > 0) THEN 
    14051492      i_rc = NF90_DEF_VAR(f_e,v_n,m_k,a_i(1:n_d),i_v) 
     
    14271514    ENDIF 
    14281515    IF (PRESENT(valid_min)) THEN 
    1429       i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',valid_min) 
     1516      SELECT CASE (m_k) 
     1517      CASE(flio_i1,flio_i2) 
     1518        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',NINT(valid_min,KIND=i_2)) 
     1519      CASE(flio_i4) 
     1520        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',NINT(valid_min,KIND=i_4)) 
     1521      CASE(flio_r4) 
     1522        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',REAL(valid_min,KIND=r_4)) 
     1523      CASE(flio_r8) 
     1524        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',REAL(valid_min,KIND=r_8)) 
     1525      CASE DEFAULT 
     1526        CALL ipslerr (2,'fliodefv', & 
     1527   &      'Variable '//TRIM(v_n),'attribute valid_min', & 
     1528   &      'not supported for this external type') 
     1529      END SELECT 
    14301530    ENDIF 
    14311531    IF (PRESENT(valid_max)) THEN 
    1432       i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',valid_max) 
     1532      SELECT CASE (m_k) 
     1533      CASE(flio_i1,flio_i2) 
     1534        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',NINT(valid_max,KIND=i_2)) 
     1535      CASE(flio_i4) 
     1536        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',NINT(valid_max,KIND=i_4)) 
     1537      CASE(flio_r4) 
     1538        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',REAL(valid_max,KIND=r_4)) 
     1539      CASE(flio_r8) 
     1540        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',REAL(valid_max,KIND=r_8)) 
     1541      CASE DEFAULT 
     1542        CALL ipslerr (2,'fliodefv', & 
     1543   &      'Variable '//TRIM(v_n),'attribute valid_max', & 
     1544   &      'not supported for this external type') 
     1545      END SELECT 
     1546    ENDIF 
     1547    IF (PRESENT(fillvalue)) THEN 
     1548      SELECT CASE (m_k) 
     1549      CASE(flio_i1,flio_i2) 
     1550        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',NINT(fillvalue,KIND=i_2)) 
     1551      CASE(flio_i4) 
     1552        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',NINT(fillvalue,KIND=i_4)) 
     1553      CASE(flio_r4) 
     1554        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',REAL(fillvalue,KIND=r_4)) 
     1555      CASE(flio_r8) 
     1556        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',REAL(fillvalue,KIND=r_8)) 
     1557      CASE DEFAULT 
     1558        CALL ipslerr (2,'fliodefv', & 
     1559   &      'Variable '//TRIM(v_n),'attribute fillvalue', & 
     1560   &      'not supported for this external type') 
     1561      END SELECT 
    14331562    ENDIF 
    14341563!--- 
     
    21772306!- 
    21782307  IF (PRESENT(mode)) THEN 
    2179     IF (TRIM(MODE) == "WRITE") THEN 
     2308    IF (TRIM(mode) == "WRITE") THEN 
    21802309      m_c = NF90_WRITE 
    21812310    ELSE 
     
    48935022  INTEGER :: kv,k,n_r,l_d,n_d,i_rc,dimnb 
    48945023  CHARACTER(LEN=1)  :: c_ax 
    4895   CHARACTER(LEN=9) :: c_sn 
     5024  CHARACTER(LEN=18) :: c_sn 
    48965025  CHARACTER(LEN=15),DIMENSION(10) :: c_r 
    48975026  CHARACTER(LEN=40) :: c_t1,c_t2 
  • vendors/IOIPSL/current/src/getincom.f90

    r1895 r1991  
    11MODULE getincom 
    22!- 
    3 !$Id: getincom.f90 536 2009-01-30 11:46:27Z bellier $ 
     3!$Id: getincom.f90 963 2010-03-31 15:26:11Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    1313!- 
    1414PRIVATE 
    15 PUBLIC :: getin, getin_dump 
     15PUBLIC :: getin_name, getin, getin_dump 
     16!- 
     17!!-------------------------------------------------------------------- 
     18!! The "getin_name" routine allows the user to change the name 
     19!! of the definition file in which the data will be read. 
     20!! ("run.def" by default) 
     21!! 
     22!!  SUBROUTINE getin_name (file_name) 
     23!! 
     24!! OPTIONAL INPUT argument 
     25!! 
     26!! (C) file_name :  the name of the file 
     27!!                  in which the data will be read 
     28!!-------------------------------------------------------------------- 
     29!- 
    1630!- 
    1731INTERFACE getin 
     
    1933!! The "getin" routines get a variable. 
    2034!! We first check if we find it in the database 
    21 !! and if not we get it from the run.def file. 
     35!! and if not we get it from the definition file. 
    2236!! 
    2337!! SUBROUTINE getin (target,ret_val) 
     
    4155!!-------------------------------------------------------------------- 
    4256!! The "getin_dump" routine will dump the content of the database 
    43 !! into a file which has the same format as the run.def file. 
     57!! into a file which has the same format as the definition file. 
    4458!! The idea is that the user can see which parameters were used 
    4559!! and re-use the file for another run. 
     
    5771  INTEGER,SAVE      :: nbfiles 
    5872!- 
     73  INTEGER,SAVE :: allread=0 
     74  CHARACTER(LEN=100),SAVE :: def_file = 'run.def' 
     75!- 
    5976  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30 
    6077  INTEGER,SAVE :: nb_lines,i_txtsize=0 
     
    7895!- 
    7996! keystatus definition 
    80 ! keystatus = 1 : Value comes from run.def 
     97! keystatus = 1 : Value comes from the file defined by 'def_file' 
    8198! keystatus = 2 : Default value is used 
    8299! keystatus = 3 : Some vector elements were taken from default 
     
    112129!- 
    113130CONTAINS 
     131!- 
     132!=== DEFINITION FILE NAME INTERFACE 
     133!- 
     134SUBROUTINE getin_name (cname) 
     135!--------------------------------------------------------------------- 
     136  IMPLICIT NONE 
     137!- 
     138  CHARACTER(LEN=*) :: cname 
     139!--------------------------------------------------------------------- 
     140  IF (allread == 0) THEN 
     141    def_file = ADJUSTL(cname) 
     142  ELSE 
     143    CALL ipslerr (3,'getin_name', & 
     144 &   'The name of the database file (any_name.def)', & 
     145 &   'must be changed *before* any attempt','to read the database.') 
     146  ENDIF 
     147!------------------------ 
     148END SUBROUTINE getin_name 
    114149!- 
    115150!=== INTEGER INTERFACE 
     
    10081043  IMPLICIT NONE 
    10091044!- 
    1010   INTEGER,SAVE :: allread=0 
    10111045  INTEGER,SAVE :: current 
    10121046!--------------------------------------------------------------------- 
     
    10211055!-- Start with reading the files 
    10221056    nbfiles = 1 
    1023     filelist(1) = 'run.def' 
     1057    filelist(1) = TRIM(def_file) 
    10241058    current = 1 
    10251059!-- 
     
    11461180!- 
    11471181  IF (check) THEN 
    1148     OPEN (UNIT=22,file='run.def.test') 
     1182    OPEN (UNIT=22,file=TRIM(def_file)//'.test') 
    11491183    DO i=1,nb_lines 
    11501184      WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i) 
     
    14161450!- 
    14171451  TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab 
    1418   CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:) 
    14191452!- 
    14201453  INTEGER :: ier 
     
    17871820        CASE(1) 
    17881821          WRITE(22,*) '# Values of ', & 
    1789  &          TRIM(key_tab(ikey)%keystr),' comes from the run.def.' 
     1822 &          TRIM(key_tab(ikey)%keystr),' comes from ',TRIM(def_file) 
    17901823        CASE(2) 
    17911824          WRITE(22,*) '# Values of ', & 
     
    17941827          WRITE(22,*) '# Values of ', & 
    17951828 &          TRIM(key_tab(ikey)%keystr), & 
    1796  &          ' are a mix of run.def and defaults.' 
     1829 &          ' are a mix of ',TRIM(def_file),' and defaults.' 
    17971830        CASE DEFAULT 
    17981831          WRITE(22,*) '# Dont know from where the value of ', & 
  • vendors/IOIPSL/current/src/histcom.f90

    r1895 r1991  
    11MODULE histcom 
    22!- 
    3 !$Id: histcom.f90 740 2009-09-17 08:26:28Z bellier $ 
     3!$Id: histcom.f90 1028 2010-05-20 15:17:30Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    3535!- to describe the grid, just two vectors. 
    3636!--------------------------------------------------------------------- 
     37!- 
     38  INTERFACE histbeg 
     39    MODULE PROCEDURE histb_reg1d,histb_reg2d,histb_irreg 
     40  END INTERFACE 
     41!- 
     42  INTERFACE histhori 
     43    MODULE PROCEDURE histh_reg1d,histh_reg2d,histh_irreg 
     44  END INTERFACE 
     45!- 
    3746  INTERFACE histwrite 
    3847!--------------------------------------------------------------------- 
     
    4655!- 
    4756!- INPUT 
    48 !- pfileid  : The ID of the file on which this variable is to be, 
     57!- idf      : The ID of the file on which this variable is to be, 
    4958!-            written. The variable should have been defined in 
    5059!-            this file before. 
     
    6372  END INTERFACE 
    6473!- 
    65   INTERFACE histbeg 
    66     MODULE PROCEDURE histbeg_totreg,histbeg_regular,histbeg_irregular 
    67   END INTERFACE 
    68 !- 
    69   INTERFACE histhori 
    70     MODULE PROCEDURE histhori_regular,histhori_irregular 
    71   END INTERFACE 
    72 !- 
    7374! Fixed parameter 
    7475!- 
     
    7677 &                     nb_hax_max=5,nb_zax_max=10,nbopp_max=10 
    7778  REAL,PARAMETER :: missing_val=nf90_fill_real 
    78 !- 
    79   INTEGER :: bufftmp_max(nb_files_max) = 1 
    80 !- 
    81 ! Time variables 
    82 !- 
    83   INTEGER,SAVE :: itau0(nb_files_max)=0 
    84   REAL,DIMENSION(nb_files_max),SAVE ::date0,deltat 
    85 !- 
    86 ! Counter of elements 
    87 !- 
    88   INTEGER,SAVE :: nb_files=0 
    89   INTEGER,DIMENSION(nb_files_max),SAVE :: nb_var=0,nb_tax=0 
    90 !- 
    91 ! DOMAIN IDs for files 
    92 !- 
    93   INTEGER,DIMENSION(nb_files_max),SAVE :: dom_id_svg=-1 
    94 !- 
    95 ! NETCDF IDs for files and axes 
    96 !- 
    97   INTEGER,DIMENSION(nb_files_max),SAVE :: ncdf_ids,xid,yid,tid 
    98 !- 
    99 ! General definitions in the NETCDF file 
    100 !- 
    101   INTEGER,DIMENSION(nb_files_max,2),SAVE :: & 
    102  &   full_size=0,slab_ori,slab_sz 
    103 !- 
    104 ! The horizontal axes 
    105 !- 
    106   INTEGER,SAVE :: nb_hax(nb_files_max)=0 
    107   CHARACTER(LEN=25),SAVE :: hax_name(nb_files_max,nb_hax_max,2) 
    108 !- 
    109 ! The vertical axes 
    110 !- 
    111   INTEGER,SAVE :: nb_zax(nb_files_max)=0 
    112   INTEGER,DIMENSION(nb_files_max,nb_zax_max),SAVE :: & 
    113   &  zax_size,zax_ids 
    114   CHARACTER(LEN=20),SAVE :: zax_name(nb_files_max,nb_zax_max) 
    115 !- 
    116 ! Informations on each variable 
    117 !- 
    118   INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: & 
    119  &  nbopp 
    120   CHARACTER(LEN=20),DIMENSION(nb_files_max,nb_var_max),SAVE :: & 
    121  &  name,unit_name 
    122   CHARACTER(LEN=80),DIMENSION(nb_files_max,nb_var_max),SAVE :: & 
    123  &  title,fullop 
    124   CHARACTER(LEN=7),SAVE :: topp(nb_files_max,nb_var_max) 
    125   CHARACTER(LEN=7),SAVE :: sopps(nb_files_max,nb_var_max,nbopp_max) 
    126   REAL,SAVE :: scal(nb_files_max,nb_var_max,nbopp_max) 
    127 !- Sizes of the associated grid and zommed area 
    128   INTEGER,DIMENSION(nb_files_max,nb_var_max,3),SAVE :: & 
    129  &   scsize,zorig,zsize 
    130 !- Sizes for the data as it goes through the various math operations 
    131   INTEGER,SAVE :: datasz_in(nb_files_max,nb_var_max,3) = -1 
    132   INTEGER,SAVE :: datasz_max(nb_files_max,nb_var_max) = -1 
    133 !- 
    134   INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: & 
    135  &  var_haxid,var_zaxid,var_axid,ncvar_ids 
    136 !- 
    137   REAL,DIMENSION(nb_files_max,nb_var_max,2),SAVE :: hist_minmax 
    138   LOGICAL,DIMENSION(nb_files_max,nb_var_max),SAVE :: & 
    139  &  hist_calc_rng=.FALSE.,hist_wrt_rng=.FALSE. 
    140 !- 
    141   REAL,DIMENSION(nb_files_max,nb_var_max),SAVE :: & 
    142  &  freq_opp,freq_wrt 
    143   INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: & 
    144  &  last_opp,last_wrt,last_opp_chk,last_wrt_chk,nb_opp,nb_wrt,point 
    145 !- 
    146 ! Book keeping for the buffers 
    147 !- 
    148   INTEGER,SAVE :: buff_pos=0 
    149   REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buffer 
    150   LOGICAL,DIMENSION(nb_files_max),SAVE :: zoom=.FALSE.,regular=.TRUE. 
    151 !- 
    152 ! Book keeping of the axes 
    153 !- 
    154   INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: & 
    155  &  tdimid,tax_last 
    156   CHARACTER(LEN=40),DIMENSION(nb_files_max,nb_var_max),SAVE :: & 
    157  &  tax_name 
     79  INTEGER,PARAMETER,PUBLIC :: & 
     80 &  hist_r4=nf90_real4, hist_r8=nf90_real8 
     81!- 
     82! Variable derived type 
     83!- 
     84TYPE T_D_V 
     85  INTEGER :: ncvid 
     86  INTEGER :: nbopp 
     87  CHARACTER(LEN=20)  :: v_name,unit_name 
     88  CHARACTER(LEN=256) :: title,std_name 
     89  CHARACTER(LEN=80)  :: fullop 
     90  CHARACTER(LEN=7)   :: topp 
     91  CHARACTER(LEN=7),DIMENSION(nbopp_max) :: sopp 
     92  REAL,DIMENSION(nbopp_max) :: scal 
     93!-External type (for R4/R8) 
     94  INTEGER :: v_typ 
     95!-Sizes of the associated grid and zommed area 
     96  INTEGER,DIMENSION(3) :: scsize,zorig,zsize 
     97!-Sizes for the data as it goes through the various math operations 
     98  INTEGER,DIMENSION(3) :: datasz_in = -1 
     99  INTEGER :: datasz_max = -1 
     100!- 
     101  INTEGER :: h_axid,z_axid,t_axid 
     102!- 
     103  REAL,DIMENSION(2) :: hist_minmax 
     104  LOGICAL :: hist_calc_rng=.FALSE.,hist_wrt_rng=.FALSE. 
     105!-Book keeping of the axes 
     106  INTEGER :: tdimid,tbndid=-1,tax_last 
     107  LOGICAL :: l_bnd 
     108  CHARACTER(LEN=40) :: tax_name 
     109!- 
     110  REAL :: freq_opp,freq_wrt 
     111  INTEGER :: & 
     112 &  last_opp,last_wrt,last_opp_chk,last_wrt_chk,nb_opp,nb_wrt 
     113!- For future optimization 
     114  REAL,POINTER,DIMENSION(:) :: t_bf 
     115!#  REAL,ALLOCATABLE,DIMENSION(:) :: V_1_D 
     116!#  REAL,ALLOCATABLE,DIMENSION(:,:) :: V_2_D 
     117!#  REAL,ALLOCATABLE,DIMENSION(:,:,:) :: V_3_D 
     118END TYPE T_D_V 
     119!- 
     120! File derived type 
     121!- 
     122TYPE :: T_D_F 
     123!-NETCDF IDs for file 
     124  INTEGER :: ncfid=-1 
     125!-Time variables 
     126  INTEGER :: itau0=0 
     127  REAL :: date0,deltat 
     128!-Counter of elements (variables, time-horizontal-vertical axis 
     129  INTEGER :: n_var=0,n_tax=0,n_hax=0,n_zax=0 
     130!-NETCDF dimension IDs for time-[time_bounds]-longitude-latitude 
     131  INTEGER :: tid,bid,xid,yid 
     132!-General definitions in the NETCDF file 
     133  INTEGER,DIMENSION(2) :: full_size=0,slab_ori,slab_siz 
     134!-The horizontal axes 
     135  CHARACTER(LEN=25),DIMENSION(nb_hax_max,2) :: hax_name 
     136!-The vertical axes 
     137  INTEGER,DIMENSION(nb_zax_max) :: zax_size,zax_ids 
     138  CHARACTER(LEN=20),DIMENSION(nb_zax_max) :: zax_name 
     139!- 
     140  LOGICAL :: regular=.TRUE. 
     141!-DOMAIN ID 
     142  INTEGER :: dom_id_svg=-1 
     143!- 
     144  TYPE(T_D_V),DIMENSION(nb_var_max) :: W_V 
     145END TYPE T_D_F 
     146!- 
     147TYPE(T_D_F),DIMENSION(nb_files_max),SAVE :: W_F 
    158148!- 
    159149! A list of functions which require special action 
     
    161151!  but they are well located here) 
    162152!- 
    163   CHARACTER(LEN=120),SAVE :: & 
    164  &  indchfun = 'scatter, fill, gather, coll', & 
    165  &  fuchnbout = 'scatter, fill' 
     153  CHARACTER(LEN=30),SAVE :: fuchnbout = 'scatter, fill' 
    166154!- Some configurable variables with locks 
    167155  CHARACTER(LEN=80),SAVE :: model_name='An IPSL model' 
     
    172160!=== 
    173161!- 
    174 SUBROUTINE histbeg_totreg                 & 
    175  & (pfilename,pim,plon,pjm,plat,          & 
    176  &  par_orix,par_szx,par_oriy,par_szy,    & 
    177  &  pitau0,pdate0,pdeltat,phoriid,pfileid,domain_id) 
    178 !--------------------------------------------------------------------- 
    179 !- This is just an interface for histbeg_regular in case when 
    180 !- the user provides plon and plat as vectors. 
    181 !- Obviously this can only be used for very regular grids. 
    182 !- 
    183 !- INPUT 
    184 !- 
    185 !- pfilename : Name of the netcdf file to be created 
    186 !- pim       : Size of arrays in longitude direction 
    187 !- plon      : Coordinates of points in longitude 
    188 !- pjm       : Size of arrays in latitude direction 
    189 !- plat      : Coordinates of points in latitude 
    190 !- 
    191 !- The next 4 arguments allow to define a horizontal zoom 
    192 !- for this file. It is assumed that all variables to come 
    193 !- have the same index space. This can not be assumed for 
    194 !- the z axis and thus we define the zoom in histdef. 
    195 !- 
    196 !- par_orix  : Origin of the slab of data within the X axis (pim) 
    197 !- par_szx   : Size of the slab of data in X 
    198 !- par_oriy  : Origin of the slab of data within the Y axis (pjm) 
    199 !- par_szy   : Size of the slab of data in Y 
    200 !- 
    201 !- pitau0    : time step at which the history tape starts 
    202 !- pdate0    : The Julian date at which the itau was equal to 0 
    203 !- pdeltat   : Time step in seconds. Time step of the counter itau 
    204 !-             used in histwrite for instance 
    205 !- 
    206 !- OUTPUT 
    207 !- 
    208 !- phoriid   : ID of the horizontal grid 
    209 !- pfileid   : ID of the netcdf file 
    210 !- 
    211 !- Optional INPUT arguments 
    212 !- 
    213 !- domain_id       : Domain identifier 
    214 !- 
    215 !- TO DO 
    216 !- 
    217 !- This package should be written in f90 
    218 !- and use the following features : 
    219 !-    - structures for the meta-data of the files and variables 
    220 !-    - memory allocation as needed 
    221 !-    - Pointers 
    222 !- 
    223 !- VERSION 
    224 !- 
     162SUBROUTINE histb_reg1d                 & 
     163 & (pfilename,pim,plon,pjm,plat,       & 
     164 &  par_orix,par_szx,par_oriy,par_szy, & 
     165 &  pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode) 
     166!--------------------------------------------------------------------- 
     167!- histbeg for 1D regular horizontal coordinates (see histb_all) 
    225168!--------------------------------------------------------------------- 
    226169  IMPLICIT NONE 
     
    233176  INTEGER,INTENT(IN) :: pitau0 
    234177  REAL,INTENT(IN) :: pdate0,pdeltat 
    235   INTEGER,INTENT(OUT) :: pfileid,phoriid 
     178  INTEGER,INTENT(OUT) :: idf,phoriid 
    236179  INTEGER,INTENT(IN),OPTIONAL :: domain_id 
    237 !- 
    238   REAL,ALLOCATABLE,DIMENSION(:,:) :: lon_tmp,lat_tmp 
    239   LOGICAL :: l_dbg 
    240 !--------------------------------------------------------------------- 
    241   CALL ipsldbg (old_status=l_dbg) 
    242 !- 
    243   IF (l_dbg) WRITE(*,*) "histbeg_totreg" 
    244 !- 
    245   ALLOCATE(lon_tmp(pim,pjm),lat_tmp(pim,pjm)) 
    246 !- 
    247   lon_tmp(:,:) = SPREAD(plon(:),2,pjm) 
    248   lat_tmp(:,:) = SPREAD(plat(:),1,pim) 
    249 !- 
    250   CALL histbeg_regular & 
    251  &  (pfilename,pim,lon_tmp,pjm,lat_tmp, & 
    252  &   par_orix,par_szx,par_oriy,par_szy, & 
    253  &   pitau0,pdate0,pdeltat,phoriid,pfileid, & 
    254  &   .TRUE.,domain_id) 
    255 !- 
    256   DEALLOCATE(lon_tmp,lat_tmp) 
    257 !---------------------------- 
    258 END SUBROUTINE histbeg_totreg 
     180  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode 
     181!--------------------------------------------------------------------- 
     182  CALL histb_all & 
     183 & (1,pfilename,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf, & 
     184 &  x_1d=plon,y_1d=plat, & 
     185 &  k_orx=par_orix,k_szx=par_szx,k_ory=par_oriy,k_szy=par_szy, & 
     186 &  domain_id=domain_id,mode=mode) 
     187!------------------------- 
     188END SUBROUTINE histb_reg1d 
    259189!=== 
    260 SUBROUTINE histbeg_regular & 
    261  & (pfilename,pim,plon,pjm,plat,           & 
    262  &  par_orix,par_szx,par_oriy,par_szy,     & 
    263  &  pitau0,pdate0,pdeltat,phoriid,pfileid, & 
    264  &  opt_rectilinear,domain_id) 
    265 !--------------------------------------------------------------------- 
    266 !- This subroutine initializes a netcdf file and returns the ID. 
    267 !- It will set up the geographical space on which the data will be 
    268 !- stored and offers the possibility of seting a zoom. 
    269 !- It also gets the global parameters into the I/O subsystem. 
    270 !- 
    271 !- INPUT 
    272 !- 
    273 !- pfilename : Name of the netcdf file to be created 
    274 !- pim       : Size of arrays in longitude direction 
    275 !- plon      : Coordinates of points in longitude 
    276 !- pjm       : Size of arrays in latitude direction 
    277 !- plat      : Coordinates of points in latitude 
    278 !- 
    279 !- The next 4 arguments allow to define a horizontal zoom 
    280 !- for this file. It is assumed that all variables to come 
    281 !- have the same index space. This can not be assumed for 
    282 !- the z axis and thus we define the zoom in histdef. 
    283 !- 
    284 !- par_orix  : Origin of the slab of data within the X axis (pim) 
    285 !- par_szx   : Size of the slab of data in X 
    286 !- par_oriy  : Origin of the slab of data within the Y axis (pjm) 
    287 !- par_szy   : Size of the slab of data in Y 
    288 !- 
    289 !- pitau0    : time step at which the history tape starts 
    290 !- pdate0    : The Julian date at which the itau was equal to 0 
    291 !- pdeltat   : Time step in seconds. Time step of the counter itau 
    292 !-             used in histwrite for instance 
    293 !- 
    294 !- OUTPUT 
    295 !- 
    296 !- phoriid   : ID of the horizontal grid 
    297 !- pfileid   : ID of the netcdf file 
    298 !- 
    299 !- Optional INPUT arguments 
    300 !- 
    301 !- opt_rectilinear : If true we know the grid is rectilinear 
    302 !- domain_id       : Domain identifier 
    303 !- 
    304 !- TO DO 
    305 !- 
    306 !- This package should be written in F90 and use the following 
    307 !- feature : 
    308 !-   - structures for the meta-data of the files and variables 
    309 !-   - memory allocation as needed 
    310 !-   - Pointers 
    311 !- 
    312 !- VERSION 
    313 !- 
     190SUBROUTINE histb_reg2d & 
     191 & (pfilename,pim,plon,pjm,plat,       & 
     192 &  par_orix,par_szx,par_oriy,par_szy, & 
     193 &  pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode) 
     194!--------------------------------------------------------------------- 
     195!- histbeg for 2D regular horizontal coordinates (see histb_all) 
    314196!--------------------------------------------------------------------- 
    315197  IMPLICIT NONE 
     
    321203  INTEGER,INTENT(IN) :: pitau0 
    322204  REAL,INTENT(IN) :: pdate0,pdeltat 
    323   INTEGER,INTENT(OUT) :: pfileid,phoriid 
    324   LOGICAL,INTENT(IN),OPTIONAL :: opt_rectilinear 
     205  INTEGER,INTENT(OUT) :: idf,phoriid 
    325206  INTEGER,INTENT(IN),OPTIONAL :: domain_id 
    326 !- 
    327   INTEGER :: ncid,iret 
    328   CHARACTER(LEN=120) :: file 
    329   CHARACTER(LEN=30) :: timenow 
    330   LOGICAL :: rectilinear 
    331   LOGICAL :: l_dbg 
    332 !--------------------------------------------------------------------- 
    333   CALL ipsldbg (old_status=l_dbg) 
    334 !- 
    335   nb_files = nb_files+1 
    336   pfileid  = nb_files 
    337 !- 
    338 ! 1.0 Transfering into the common for future use 
    339 !- 
    340   IF (l_dbg) WRITE(*,*) "histbeg_regular 1.0" 
    341 !- 
    342   itau0(pfileid) = pitau0 
    343   date0(pfileid) = pdate0 
    344   deltat(pfileid) = pdeltat 
    345 !- 
    346   IF (PRESENT(opt_rectilinear)) THEN 
    347     rectilinear = opt_rectilinear 
    348   ELSE 
    349     rectilinear = .FALSE. 
    350   ENDIF 
    351 !- 
    352 ! 2.0 Initializes all variables for this file 
    353 !- 
    354   IF (l_dbg) WRITE(*,*) "histbeg_regular 2.0" 
    355 !- 
    356   IF (nb_files > nb_files_max) THEN 
    357     CALL ipslerr (3,"histbeg", & 
    358    &  'Table of files too small. You should increase nb_files_max', & 
    359    &  'in histcom.f90 in order to accomodate all these files',' ') 
    360   ENDIF 
    361 !- 
    362   nb_var(pfileid) = 0 
    363   nb_tax(pfileid) = 0 
    364   nb_hax(pfileid) = 0 
    365   nb_zax(pfileid) = 0 
    366 !- 
    367   slab_ori(pfileid,1:2) = (/ par_orix,par_oriy /) 
    368   slab_sz(pfileid,1:2)  = (/ par_szx, par_szy  /) 
    369 !- 
    370 ! 3.0 Opening netcdf file and defining dimensions 
    371 !- 
    372   IF (l_dbg) WRITE(*,*) "histbeg_regular 3.0" 
    373 !- 
    374 ! Add DOMAIN number and ".nc" suffix in file name if needed 
    375 !- 
    376   file = pfilename 
    377   CALL flio_dom_file (file,domain_id) 
    378 !- 
    379   iret = NF90_CREATE (file,NF90_CLOBBER,ncid) 
    380 !- 
    381   IF (rectilinear) THEN 
    382     iret = NF90_DEF_DIM (ncid,'lon',par_szx,xid(nb_files)) 
    383     iret = NF90_DEF_DIM (ncid,'lat',par_szy,yid(nb_files)) 
    384   ELSE 
    385     iret = NF90_DEF_DIM (ncid,'x',par_szx,xid(nb_files)) 
    386     iret = NF90_DEF_DIM (ncid,'y',par_szy,yid(nb_files)) 
    387   ENDIF 
    388 !- 
    389 ! 4.0 Declaring the geographical coordinates and other attributes 
    390 !- 
    391   IF (l_dbg) WRITE(*,*) "histbeg_regular 4.0" 
    392 !- 
    393 ! 4.3 Global attributes 
    394 !- 
    395   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1') 
    396   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file)) 
    397   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name)) 
    398   lock_modname = .TRUE. 
    399   CALL ioget_timestamp (timenow) 
    400   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'TimeStamp',TRIM(timenow)) 
    401 !- 
    402 ! 5.0 Saving some important information on this file in the common 
    403 !- 
    404   IF (l_dbg) WRITE(*,*) "histbeg_regular 5.0" 
    405 !- 
    406   IF (PRESENT(domain_id)) THEN 
    407     dom_id_svg(pfileid) = domain_id 
    408   ENDIF 
    409   ncdf_ids(pfileid) = ncid 
    410   full_size(pfileid,1:2) = (/ pim,pjm /) 
    411 !- 
    412 ! 6.0 storing the geographical coordinates 
    413 !- 
    414   zoom(pfileid) = (pim /= par_szx).OR.(pjm /= par_szy) 
    415   regular(pfileid)=.TRUE. 
    416 !- 
    417   CALL histhori_regular (pfileid,pim,plon,pjm,plat, & 
    418  &  ' ' ,'Default grid',phoriid,rectilinear) 
    419 !----------------------------- 
    420 END SUBROUTINE histbeg_regular 
     207  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode 
     208!--------------------------------------------------------------------- 
     209  CALL histb_all & 
     210 & (2,pfilename,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf,  & 
     211 &  x_2d=plon,y_2d=plat, & 
     212 &  k_orx=par_orix,k_szx=par_szx,k_ory=par_oriy,k_szy=par_szy,    & 
     213 &  domain_id=domain_id,mode=mode) 
     214!------------------------- 
     215END SUBROUTINE histb_reg2d 
    421216!=== 
    422 SUBROUTINE histbeg_irregular & 
    423  &  (pfilename,pim,plon,plon_bounds,plat,plat_bounds,   & 
    424  &   pitau0,pdate0,pdeltat,phoriid,pfileid,domain_id) 
    425 !--------------------------------------------------------------------- 
    426 !- This subroutine initializes a netcdf file and returns the ID. 
    427 !- This version is for totaly irregular grids. In this case all 
    428 !- all the data comes in as vectors and for the grid we have 
    429 !- the coordinates of the 4 corners. 
    430 !- It also gets the global parameters into the I/O subsystem. 
    431 !- 
    432 !- INPUT 
    433 !- 
    434 !- pfilename   : Name of the netcdf file to be created 
    435 !- pim         : Size of arrays in longitude direction 
    436 !- plon        : Coordinates of points in longitude 
    437 !- plon_bounds : The 2 corners of the grid in longitude 
    438 !- plat        : Coordinates of points in latitude 
    439 !- plat_bounds : The 2 corners of the grid in latitude 
    440 !- 
    441 !- pitau0    : time step at which the history tape starts 
    442 !- pdate0    : The Julian date at which the itau was equal to 0 
    443 !- pdeltat   : Time step in seconds. Time step of the counter itau 
    444 !-             used in histwrite for instance 
    445 !- 
    446 !- OUTPUT 
    447 !- 
    448 !- phoriid   : ID of the horizontal grid 
    449 !- pfileid   : ID of the netcdf file 
    450 !- 
    451 !- Optional INPUT arguments 
    452 !- 
    453 !- domain_id       : Domain identifier 
    454 !- 
    455 !- TO DO 
    456 !- 
    457 !- This package should be written in F90 and use the following 
    458 !- feature : 
    459 !-   - structures for the meta-data of the files and variables 
    460 !-   - memory allocation as needed 
    461 !-   - Pointers 
    462 !- 
    463 !- VERSION 
    464 !- 
     217SUBROUTINE histb_irreg & 
     218 &  (pfilename,pim,plon,plon_bounds,plat,plat_bounds, & 
     219 &   pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode) 
     220!--------------------------------------------------------------------- 
     221!- histbeg for irregular horizontal coordinates (see histb_all) 
    465222!--------------------------------------------------------------------- 
    466223  IMPLICIT NONE 
     
    472229  INTEGER,INTENT(IN) :: pitau0 
    473230  REAL,INTENT(IN) :: pdate0,pdeltat 
    474   INTEGER,INTENT(OUT) :: pfileid,phoriid 
     231  INTEGER,INTENT(OUT) :: idf,phoriid 
    475232  INTEGER,INTENT(IN),OPTIONAL :: domain_id 
    476 !- 
    477   INTEGER :: ncid,iret 
     233  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode 
     234!--------------------------------------------------------------------- 
     235  CALL histb_all & 
     236 & (3,pfilename,pim,pim,pitau0,pdate0,pdeltat,phoriid,idf,  & 
     237 &  x_1d=plon,y_1d=plat,x_bnds=plon_bounds,y_bnds=plat_bounds, & 
     238 &  domain_id=domain_id,mode=mode) 
     239!------------------------- 
     240END SUBROUTINE histb_irreg 
     241!=== 
     242SUBROUTINE histb_all & 
     243 & (k_typ,nc_name,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf, & 
     244 &  x_1d,y_1d,x_2d,y_2d,k_orx,k_szx,k_ory,k_szy, & 
     245 &  x_bnds,y_bnds,domain_id,mode) 
     246!--------------------------------------------------------------------- 
     247!- General interface for horizontal grids. 
     248!- This subroutine initializes a netcdf file and returns the ID. 
     249!- It will set up the geographical space on which the data will be 
     250!- stored and offers the possibility of seting a zoom. 
     251!- In the case of irregular grids, all the data comes in as vectors 
     252!- and for the grid we have the coordinates of the 4 corners. 
     253!- It also gets the global parameters into the I/O subsystem. 
     254!- 
     255!- INPUT 
     256!- 
     257!- k_typ    : Type of the grid (1 rectilinear, 2 regular, 3 irregular) 
     258!- nc_name  : Name of the netcdf file to be created 
     259!- pim      : Size of arrays in longitude direction 
     260!- pjm      : Size of arrays in latitude direction (pjm=pim for type 3) 
     261!- 
     262!- pitau0   : time step at which the history tape starts 
     263!- pdate0   : The Julian date at which the itau was equal to 0 
     264!- pdeltat  : Time step, in seconds, of the counter itau 
     265!-            used in histwrite for instance 
     266!- 
     267!- OUTPUT 
     268!- 
     269!- phoriid  : Identifier of the horizontal grid 
     270!- idf      : Identifier of the file 
     271!- 
     272!- Optional INPUT arguments 
     273!- 
     274!- For rectilinear or irregular grid 
     275!- x_1d  : The longitudes 
     276!- y_1d  : The latitudes 
     277!- For regular grid 
     278!- x_2d  : The longitudes 
     279!- y_2d  : The latitudes 
     280!- One pair (x_1d,y_1d) or (x_2d,y_2d) must be supplied. 
     281!- 
     282!- For regular grid (reg1d or reg2d), 
     283!- the next 4 arguments allow to define a horizontal zoom 
     284!- for this file. It is assumed that all variables to come 
     285!- have the same index space. This can not be assumed for 
     286!- the z axis and thus we define the zoom in histdef. 
     287!- k_orx  : Origin of the slab of data within the X axis (pim) 
     288!- k_szx  : Size of the slab of data in X 
     289!- k_ory  : Origin of the slab of data within the Y axis (pjm) 
     290!- k_szy  : Size of the slab of data in Y 
     291!- 
     292!- For irregular grid. 
     293!- x_bnds : The boundaries of the grid in longitude 
     294!- y_bnds : The boundaries of the grid in latitude 
     295!- 
     296!- For all grids. 
     297!- 
     298!- domain_id  : Domain identifier 
     299!- 
     300!- mode       : String of (case insensitive) blank-separated words 
     301!-              defining the mode used to create the file. 
     302!-              Supported keywords : 32, 64 
     303!-              "32/64" defines the offset mode. 
     304!-              The default offset mode is 64 bits. 
     305!-              Keywords "NETCDF4" and "CLASSIC" are reserved 
     306!-              for future use. 
     307!--------------------------------------------------------------------- 
     308  IMPLICIT NONE 
     309!- 
     310  INTEGER,INTENT(IN) :: k_typ 
     311  CHARACTER(LEN=*),INTENT(IN) :: nc_name 
     312  INTEGER,INTENT(IN) :: pim,pjm 
     313  INTEGER,INTENT(IN) :: pitau0 
     314  REAL,INTENT(IN) :: pdate0,pdeltat 
     315  INTEGER,INTENT(OUT) :: idf,phoriid 
     316  REAL,DIMENSION(:),INTENT(IN),OPTIONAL :: x_1d,y_1d 
     317  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_2d,y_2d 
     318  INTEGER,INTENT(IN),OPTIONAL :: k_orx,k_szx,k_ory,k_szy 
     319  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_bnds,y_bnds 
     320  INTEGER,INTENT(IN),OPTIONAL :: domain_id 
     321  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode 
     322!- 
     323  INTEGER :: nfid,iret,m_c 
    478324  CHARACTER(LEN=120) :: file 
    479325  CHARACTER(LEN=30) :: timenow 
     326  CHARACTER(LEN=11) :: c_nam 
    480327  LOGICAL :: l_dbg 
    481328!--------------------------------------------------------------------- 
    482329  CALL ipsldbg (old_status=l_dbg) 
    483330!- 
    484   nb_files = nb_files+1 
    485   pfileid  = nb_files 
    486 !- 
    487 ! 1.0 Transfering into the common for future use 
    488 !- 
    489   IF (l_dbg) WRITE(*,*) "histbeg_irregular 1.0" 
    490 !- 
    491   itau0(pfileid) = pitau0 
    492   date0(pfileid) = pdate0 
    493   deltat(pfileid) = pdeltat 
    494 !- 
    495 ! 2.0 Initializes all variables for this file 
    496 !- 
    497   IF (l_dbg) WRITE(*,*) "histbeg_irregular 2.0" 
    498 !- 
    499   IF (nb_files > nb_files_max) THEN 
     331  IF     (k_typ == 1) THEN 
     332    c_nam = 'histb_reg1d' 
     333  ELSEIF (k_typ == 2) THEN 
     334    c_nam = 'histb_reg2d' 
     335  ELSEIF (k_typ == 3) THEN 
     336    c_nam = 'histb_irreg' 
     337  ELSE 
     338    CALL ipslerr (3,"histbeg", & 
     339 &    'Illegal value of k_typ argument','in internal interface','?') 
     340  ENDIF 
     341!- 
     342  IF (l_dbg) WRITE(*,*) c_nam//" 0.0" 
     343!- 
     344! Search for a free index 
     345!- 
     346  idf = -1 
     347  DO nfid=1,nb_files_max 
     348    IF (W_F(nfid)%ncfid < 0) THEN 
     349      idf = nfid; EXIT; 
     350    ENDIF 
     351  ENDDO 
     352  IF (idf < 0) THEN 
    500353    CALL ipslerr (3,"histbeg", & 
    501354   &  'Table of files too small. You should increase nb_files_max', & 
     
    503356  ENDIF 
    504357!- 
    505   nb_var(pfileid) = 0 
    506   nb_tax(pfileid) = 0 
    507   nb_hax(pfileid) = 0 
    508   nb_zax(pfileid) = 0 
    509 !- 
    510   slab_ori(pfileid,1:2) = (/ 1,1 /) 
    511   slab_sz(pfileid,1:2)  = (/ pim,1 /) 
     358! 1.0 Transfering into the common for future use 
     359!- 
     360  IF (l_dbg) WRITE(*,*) c_nam//" 1.0" 
     361!- 
     362  W_F(idf)%itau0  = pitau0 
     363  W_F(idf)%date0  = pdate0 
     364  W_F(idf)%deltat = pdeltat 
     365!- 
     366! 2.0 Initializes all variables for this file 
     367!- 
     368  IF (l_dbg) WRITE(*,*) c_nam//" 2.0" 
     369!- 
     370  W_F(idf)%n_var = 0 
     371  W_F(idf)%n_tax = 0 
     372  W_F(idf)%n_hax = 0 
     373  W_F(idf)%n_zax = 0 
     374!- 
     375  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN 
     376    W_F(idf)%slab_ori(1:2) = (/ k_orx,k_ory /) 
     377    W_F(idf)%slab_siz(1:2)  = (/ k_szx,k_szy /) 
     378  ELSE 
     379    W_F(idf)%slab_ori(1:2) = (/ 1,1 /) 
     380    W_F(idf)%slab_siz(1:2) = (/ pim,1 /) 
     381  ENDIF 
    512382!- 
    513383! 3.0 Opening netcdf file and defining dimensions 
    514384!- 
    515   IF (l_dbg) WRITE(*,*) "histbeg_irregular 3.0" 
     385  IF (l_dbg) WRITE(*,*) c_nam//" 3.0" 
    516386!- 
    517387! Add DOMAIN number and ".nc" suffix in file name if needed 
    518388!- 
    519   file  = pfilename 
     389  file = nc_name 
    520390  CALL flio_dom_file (file,domain_id) 
    521391!- 
    522   iret = NF90_CREATE (file,NF90_CLOBBER,ncid) 
    523 !- 
    524   iret = NF90_DEF_DIM (ncid,'x',pim,xid(nb_files)) 
    525   yid(nb_files) = 0 
     392! Check the mode 
     393!? See fliocom for HDF4 ???????????????????????????????????????????????? 
     394!- 
     395  IF (PRESENT(mode)) THEN 
     396    SELECT CASE (TRIM(mode)) 
     397    CASE('32') 
     398      m_c = NF90_CLOBBER 
     399    CASE('64') 
     400      m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET) 
     401    CASE DEFAULT 
     402      CALL ipslerr (3,"histbeg", & 
     403 &      'Invalid argument mode for file :',TRIM(file), & 
     404 &      'Supported values are 32 or 64') 
     405    END SELECT 
     406  ELSE 
     407    m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET) 
     408  ENDIF 
     409!- 
     410! Create file 
     411!- 
     412  iret = NF90_CREATE(file,m_c,nfid) 
     413!- 
     414  IF     (k_typ == 1) THEN 
     415    iret = NF90_DEF_DIM(nfid,'lon',k_szx,W_F(idf)%xid) 
     416    iret = NF90_DEF_DIM(nfid,'lat',k_szy,W_F(idf)%yid) 
     417  ELSEIF (k_typ == 2) THEN 
     418    iret = NF90_DEF_DIM(nfid,'x',k_szx,W_F(idf)%xid) 
     419    iret = NF90_DEF_DIM(nfid,'y',k_szy,W_F(idf)%yid) 
     420  ELSEIF (k_typ == 3) THEN 
     421    iret = NF90_DEF_DIM(nfid,'x',pim,W_F(idf)%xid) 
     422    W_F(idf)%yid = W_F(idf)%xid 
     423  ENDIF 
    526424!- 
    527425! 4.0 Declaring the geographical coordinates and other attributes 
    528426!- 
    529   IF (l_dbg) WRITE(*,*) "histbeg_irregular 4.0" 
    530 !- 
    531 ! 4.3 Global attributes 
    532 !- 
    533   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1') 
    534   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file)) 
    535   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name)) 
     427  IF (l_dbg) WRITE(*,*) c_nam//" 4.0" 
     428!- 
     429  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'Conventions','CF-1.1') 
     430  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'file_name',TRIM(file)) 
     431  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'production',TRIM(model_name)) 
    536432  lock_modname = .TRUE. 
    537433  CALL ioget_timestamp (timenow) 
    538   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'TimeStamp',TRIM(timenow)) 
     434  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'TimeStamp',TRIM(timenow)) 
    539435!- 
    540436! 5.0 Saving some important information on this file in the common 
    541437!- 
    542   IF (l_dbg) WRITE(*,*) "histbeg_irregular 5.0" 
     438  IF (l_dbg) WRITE(*,*) c_nam//" 5.0" 
    543439!- 
    544440  IF (PRESENT(domain_id)) THEN 
    545     dom_id_svg(pfileid) = domain_id 
    546   ENDIF 
    547   ncdf_ids(pfileid) = ncid 
    548   full_size(pfileid,1:2) = (/ pim,1 /) 
     441    W_F(idf)%dom_id_svg = domain_id 
     442  ENDIF 
     443  W_F(idf)%ncfid = nfid 
     444  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN 
     445    W_F(idf)%full_size(1:2) = (/ pim,pjm /) 
     446    W_F(idf)%regular=.TRUE. 
     447  ELSEIF (k_typ == 3) THEN 
     448    W_F(idf)%full_size(1:2) = (/ pim,1 /) 
     449    W_F(idf)%regular=.FALSE. 
     450  ENDIF 
    549451!- 
    550452! 6.0 storing the geographical coordinates 
    551453!- 
    552   zoom(pfileid)=.FALSE. 
    553   regular(pfileid)=.FALSE. 
    554 !- 
    555   CALL histhori_irregular & 
    556  &  (pfileid,pim,plon,plon_bounds,plat,plat_bounds, & 
    557  &   ' ' ,'Default grid',phoriid) 
    558 !------------------------------- 
    559 END SUBROUTINE histbeg_irregular 
     454  IF     (k_typ == 1) THEN 
     455    CALL histh_all & 
     456 &   (k_typ,idf,pim,pjm,' ','Default grid',phoriid, & 
     457 &    x_1d=x_1d,y_1d=y_1d) 
     458  ELSEIF (k_typ == 2) THEN 
     459    CALL histh_all & 
     460 &   (k_typ,idf,pim,pjm,' ','Default grid',phoriid, & 
     461 &    x_2d=x_2d,y_2d=y_2d) 
     462  ELSEIF (k_typ == 3) THEN 
     463    CALL histh_all & 
     464 &   (k_typ,idf,pim,pim,' ','Default grid',phoriid, & 
     465 &    x_1d=x_1d,y_1d=y_1d,x_bnds=x_bnds,y_bnds=y_bnds) 
     466  ENDIF 
     467!----------------------- 
     468END SUBROUTINE histb_all 
    560469!=== 
    561 SUBROUTINE histhori_regular & 
    562  &  (pfileid,pim,plon,pjm,plat,phname,phtitle,phid,opt_rectilinear) 
    563 !--------------------------------------------------------------------- 
    564 !- This subroutine is made to declare a new horizontale grid. 
     470SUBROUTINE histh_reg1d & 
     471 &  (idf,pim,plon,pjm,plat,phname,phtitle,phid) 
     472!--------------------------------------------------------------------- 
     473!- histhori for 1d regular grid (see histh_all) 
     474!--------------------------------------------------------------------- 
     475  IMPLICIT NONE 
     476!- 
     477  INTEGER,INTENT(IN) :: idf,pim,pjm 
     478  REAL,INTENT(IN),DIMENSION(:) :: plon,plat 
     479  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle 
     480  INTEGER,INTENT(OUT) :: phid 
     481!--------------------------------------------------------------------- 
     482  CALL histh_all & 
     483 & (1,idf,pim,pjm,phname,phtitle,phid,x_1d=plon,y_1d=plat) 
     484!------------------------- 
     485END SUBROUTINE histh_reg1d 
     486!=== 
     487SUBROUTINE histh_reg2d & 
     488 & (idf,pim,plon,pjm,plat,phname,phtitle,phid) 
     489!--------------------------------------------------------------------- 
     490!- histhori for 2d regular grid (see histh_all) 
     491!--------------------------------------------------------------------- 
     492  IMPLICIT NONE 
     493!- 
     494  INTEGER,INTENT(IN) :: idf,pim,pjm 
     495  REAL,INTENT(IN),DIMENSION(:,:) :: plon,plat 
     496  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle 
     497  INTEGER,INTENT(OUT) :: phid 
     498!--------------------------------------------------------------------- 
     499  CALL histh_all & 
     500 & (2,idf,pim,pjm,phname,phtitle,phid,x_2d=plon,y_2d=plat) 
     501!------------------------- 
     502END SUBROUTINE histh_reg2d 
     503!=== 
     504SUBROUTINE histh_irreg & 
     505 & (idf,pim,plon,plon_bounds,plat,plat_bounds,phname,phtitle,phid) 
     506!--------------------------------------------------------------------- 
     507!- histhori for irregular grid (see histh_all) 
     508!--------------------------------------------------------------------- 
     509  IMPLICIT NONE 
     510!- 
     511  INTEGER,INTENT(IN) :: idf,pim 
     512  REAL,DIMENSION(:),INTENT(IN) :: plon,plat 
     513  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds 
     514  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle 
     515  INTEGER,INTENT(OUT) :: phid 
     516!--------------------------------------------------------------------- 
     517  CALL histh_all & 
     518 & (3,idf,pim,pim,phname,phtitle,phid, & 
     519 &  x_1d=plon,y_1d=plat,x_bnds=plon_bounds,y_bnds=plat_bounds) 
     520!------------------------- 
     521END SUBROUTINE histh_irreg 
     522!=== 
     523SUBROUTINE histh_all & 
     524 & (k_typ,idf,pim,pjm,phname,phtitle,phid, & 
     525 &  x_1d,y_1d,x_2d,y_2d,x_bnds,y_bnds) 
     526!--------------------------------------------------------------------- 
     527!- General interface for horizontal grids. 
     528!- This subroutine is made to declare a new horizontal grid. 
    565529!- It has to have the same number of points as 
    566530!- the original and thus in this routine we will only 
     
    572536!- INPUT 
    573537!- 
    574 !- pfileid : The id of the file to which the grid should be added 
     538!- k_typ   : Type of the grid (1 rectilinear, 2 regular, 3 irregular) 
     539!- idf     : The id of the file to which the grid should be added 
    575540!- pim     : Size in the longitude direction 
    576 !- plon    : The longitudes 
    577 !- pjm     : Size in the latitude direction 
    578 !- plat    : The latitudes 
     541!- pjm     : Size in the latitude direction (pjm=pim for type 3) 
    579542!- phname  : The name of grid 
    580543!- phtitle : The title of the grid 
     
    584547!- phid    : Id of the created grid 
    585548!- 
    586 !- OPTIONAL 
    587 !- 
    588 !- opt_rectilinear : If true we know the grid is rectilinear. 
    589 !- 
     549!- Optional INPUT arguments 
     550!- 
     551!- For rectilinear or irregular grid 
     552!- x_1d  : The longitudes 
     553!- y_1d  : The latitudes 
     554!- For regular grid 
     555!- x_2d  : The longitudes 
     556!- y_2d  : The latitudes 
     557!- One pair (x_1d,y_1d) or (x_2d,y_2d) must be supplied. 
     558!- 
     559!- For irregular grid. 
     560!- x_bnds : The boundaries of the grid in longitude 
     561!- y_bnds : The boundaries of the grid in latitude 
    590562!--------------------------------------------------------------------- 
    591563  IMPLICIT NONE 
    592564!- 
    593   INTEGER,INTENT(IN) :: pfileid,pim,pjm 
    594   REAL,INTENT(IN),DIMENSION(pim,pjm) :: plon,plat 
     565  INTEGER,INTENT(IN) :: k_typ 
     566  INTEGER,INTENT(IN) :: idf,pim,pjm 
    595567  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle 
    596568  INTEGER,INTENT(OUT) :: phid 
    597   LOGICAL,INTENT(IN),OPTIONAL :: opt_rectilinear 
     569  REAL,DIMENSION(:),INTENT(IN),OPTIONAL :: x_1d,y_1d 
     570  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_2d,y_2d 
     571  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_bnds,y_bnds 
    598572!- 
    599573  CHARACTER(LEN=25) :: lon_name,lat_name 
    600   CHARACTER(LEN=80) :: tmp_title,tmp_name 
    601   INTEGER :: ndim 
    602   INTEGER,DIMENSION(2) :: dims 
     574  CHARACTER(LEN=30) :: lonbound_name,latbound_name 
     575  INTEGER :: i_s,i_e 
     576  INTEGER,DIMENSION(2) :: dims,dims_b 
     577  INTEGER :: nbbounds 
     578  INTEGER :: nlonidb,nlatidb,twoid 
     579  LOGICAL :: transp = .FALSE. 
     580  REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans 
     581  REAL :: wmn,wmx 
    603582  INTEGER :: nlonid,nlatid 
    604   INTEGER :: orix,oriy,par_szx,par_szy 
    605   INTEGER :: iret,ncid 
    606   LOGICAL :: rectilinear 
     583  INTEGER :: o_x,o_y,s_x,s_y 
     584  INTEGER :: iret,nfid 
     585  CHARACTER(LEN=11) :: c_nam 
    607586  LOGICAL :: l_dbg 
    608587!--------------------------------------------------------------------- 
    609588  CALL ipsldbg (old_status=l_dbg) 
    610589!- 
     590  IF     (k_typ == 1) THEN 
     591    c_nam = 'histh_reg1d' 
     592  ELSEIF (k_typ == 2) THEN 
     593    c_nam = 'histh_reg2d' 
     594  ELSEIF (k_typ == 3) THEN 
     595    c_nam = 'histh_irreg' 
     596  ELSE 
     597    CALL ipslerr (3,"histhori", & 
     598 &    'Illegal value of k_typ argument','in internal interface','?') 
     599  ENDIF 
     600!- 
    611601! 1.0 Check that all fits in the buffers 
    612602!- 
    613   IF (    (pim /= full_size(pfileid,1)) & 
    614     & .OR.(pjm /= full_size(pfileid,2)) ) THEN 
     603  IF (    (pim /= W_F(idf)%full_size(1)) & 
     604 &    .OR.(W_F(idf)%regular.AND.(pjm /= W_F(idf)%full_size(2)))  & 
     605 &    .OR.(.NOT.W_F(idf)%regular.AND.(W_F(idf)%full_size(2) /= 1)) ) THEN 
    615606    CALL ipslerr (3,"histhori", & 
    616    &  'The new horizontal grid does not have the same size', & 
    617    &  'as the one provided to histbeg. This is not yet ', & 
    618    &  'possible in the hist package.') 
    619   ENDIF 
    620 !- 
    621   IF (PRESENT(opt_rectilinear)) THEN 
    622     rectilinear = opt_rectilinear 
    623   ELSE 
    624     rectilinear = .FALSE. 
     607 &   'The new horizontal grid does not have the same size', & 
     608 &   'as the one provided to histbeg. This is not yet ', & 
     609 &   'possible in the hist package.') 
    625610  ENDIF 
    626611!- 
    627612! 1.1 Create all the variables needed 
    628613!- 
    629   IF (l_dbg) WRITE(*,*) "histhori_regular 1.0" 
    630 !- 
    631   ncid = ncdf_ids(pfileid) 
    632 !- 
    633   ndim = 2 
    634   dims(1:2) = (/ xid(pfileid),yid(pfileid) /) 
    635 !- 
    636   tmp_name = phname 
    637   IF (rectilinear) THEN 
    638     IF (nb_hax(pfileid) == 0) THEN 
     614  IF (l_dbg) WRITE(*,*) c_nam//" 1.0" 
     615!- 
     616  nfid = W_F(idf)%ncfid 
     617!- 
     618  IF (k_typ == 3) THEN 
     619    IF     (SIZE(x_bnds,DIM=1) == pim) THEN 
     620      nbbounds = SIZE(x_bnds,DIM=2) 
     621      transp = .TRUE. 
     622    ELSEIF (SIZE(x_bnds,DIM=2) == pim) THEN 
     623      nbbounds = SIZE(x_bnds,DIM=1) 
     624      transp = .FALSE. 
     625    ELSE 
     626      CALL ipslerr (3,"histhori", & 
     627 &     'The boundary variable does not have any axis corresponding', & 
     628 &     'to the size of the longitude or latitude variable','.') 
     629    ENDIF 
     630    ALLOCATE(bounds_trans(nbbounds,pim)) 
     631    iret = NF90_DEF_DIM(nfid,'nbnd',nbbounds,twoid) 
     632    dims_b(1:2) = (/ twoid,W_F(idf)%xid /) 
     633  ENDIF 
     634!- 
     635  dims(1:2) = (/ W_F(idf)%xid,W_F(idf)%yid /) 
     636!- 
     637  IF     (k_typ == 1) THEN 
     638    IF (W_F(idf)%n_hax == 0) THEN 
    639639      lon_name = 'lon' 
    640640      lat_name = 'lat' 
    641641    ELSE 
    642       lon_name = 'lon_'//TRIM(tmp_name) 
    643       lat_name = 'lat_'//TRIM(tmp_name) 
    644     ENDIF 
    645   ELSE 
    646     IF (nb_hax(pfileid) == 0) THEN 
     642      lon_name = 'lon_'//TRIM(phname) 
     643      lat_name = 'lat_'//TRIM(phname) 
     644    ENDIF 
     645  ELSEIF (k_typ == 2) THEN 
     646    IF (W_F(idf)%n_hax == 0) THEN 
    647647      lon_name = 'nav_lon' 
    648648      lat_name = 'nav_lat' 
    649649    ELSE 
    650       lon_name = 'nav_lon_'//TRIM(tmp_name) 
    651       lat_name = 'nav_lat_'//TRIM(tmp_name) 
    652     ENDIF 
     650      lon_name = 'nav_lon_'//TRIM(phname) 
     651      lat_name = 'nav_lat_'//TRIM(phname) 
     652    ENDIF 
     653  ELSEIF (k_typ == 3) THEN 
     654    IF (W_F(idf)%n_hax == 0) THEN 
     655      lon_name = 'nav_lon' 
     656      lat_name = 'nav_lat' 
     657    ELSE 
     658      lon_name = 'nav_lon_'//TRIM(phname) 
     659      lat_name = 'nav_lat_'//TRIM(phname) 
     660    ENDIF 
     661    lonbound_name = TRIM(lon_name)//'_bounds' 
     662    latbound_name = TRIM(lat_name)//'_bounds' 
    653663  ENDIF 
    654664!- 
    655665! 1.2 Save the informations 
    656666!- 
    657   phid =  nb_hax(pfileid)+1 
    658   nb_hax(pfileid) = phid 
    659 !- 
    660   hax_name(pfileid,phid,1:2) = (/ lon_name,lat_name /) 
    661   tmp_title = phtitle 
     667  phid = W_F(idf)%n_hax+1 
     668  W_F(idf)%n_hax = phid 
     669  W_F(idf)%hax_name(phid,1:2) = (/ lon_name,lat_name /) 
    662670!- 
    663671! 2.0 Longitude 
    664672!- 
    665   IF (l_dbg) WRITE(*,*) "histhori_regular 2.0" 
    666 !- 
    667   IF (rectilinear) THEN 
    668     ndim = 1 
    669     dims(1:1) = (/ xid(pfileid) /) 
    670   ENDIF 
    671   iret = NF90_DEF_VAR (ncid,lon_name,NF90_FLOAT,dims(1:ndim),nlonid) 
    672   IF (rectilinear) THEN 
    673     iret = NF90_PUT_ATT (ncid,nlonid,'axis',"X") 
    674   ENDIF 
    675   iret = NF90_PUT_ATT (ncid,nlonid,'standard_name',"longitude") 
    676   iret = NF90_PUT_ATT (ncid,nlonid,'units',"degrees_east") 
    677   iret = NF90_PUT_ATT (ncid,nlonid,'valid_min', & 
    678  &                     REAL(MINVAL(plon),KIND=4)) 
    679   iret = NF90_PUT_ATT (ncid,nlonid,'valid_max', & 
    680  &                     REAL(MAXVAL(plon),KIND=4)) 
    681   iret = NF90_PUT_ATT (ncid,nlonid,'long_name',"Longitude") 
    682   iret = NF90_PUT_ATT (ncid,nlonid,'nav_model',TRIM(tmp_title)) 
     673  IF (l_dbg) WRITE(*,*) c_nam//" 2.0" 
     674!- 
     675  i_s = 1; 
     676  IF ( (k_typ == 1).OR.(k_typ == 3) ) THEN 
     677    i_e = 1; wmn = MINVAL(x_1d); wmx = MAXVAL(x_1d); 
     678  ELSEIF (k_typ == 2) THEN 
     679    i_e = 2; wmn = MINVAL(x_2d); wmx = MAXVAL(x_2d); 
     680  ENDIF 
     681  iret = NF90_DEF_VAR(nfid,lon_name,NF90_REAL4,dims(i_s:i_e),nlonid) 
     682  IF (k_typ == 1) THEN 
     683    iret = NF90_PUT_ATT(nfid,nlonid,'axis',"X") 
     684  ENDIF 
     685  iret = NF90_PUT_ATT(nfid,nlonid,'standard_name',"longitude") 
     686  iret = NF90_PUT_ATT(nfid,nlonid,'units',"degrees_east") 
     687  iret = NF90_PUT_ATT(nfid,nlonid,'valid_min',REAL(wmn,KIND=4)) 
     688  iret = NF90_PUT_ATT(nfid,nlonid,'valid_max',REAL(wmx,KIND=4)) 
     689  iret = NF90_PUT_ATT(nfid,nlonid,'long_name',"Longitude") 
     690  iret = NF90_PUT_ATT(nfid,nlonid,'nav_model',TRIM(phtitle)) 
     691!- 
     692  IF (k_typ == 3) THEN 
     693!--- 
     694!-- 2.1 Longitude bounds 
     695!--- 
     696    iret = NF90_PUT_ATT(nfid,nlonid,'bounds',TRIM(lonbound_name)) 
     697    iret = NF90_DEF_VAR(nfid,lonbound_name,NF90_REAL4,dims_b(1:2),nlonidb) 
     698    iret = NF90_PUT_ATT(nfid,nlonidb,'long_name', & 
     699 &          'Boundaries for coordinate variable '//TRIM(lon_name)) 
     700  ENDIF 
    683701!- 
    684702! 3.0 Latitude 
    685703!- 
    686   IF (l_dbg) WRITE(*,*) "histhori_regular 3.0" 
    687 !- 
    688   IF (rectilinear) THEN 
    689     ndim = 1 
    690     dims(1:1) = (/ yid(pfileid) /) 
    691   ENDIF 
    692   iret = NF90_DEF_VAR (ncid,lat_name,NF90_FLOAT,dims(1:ndim),nlatid) 
    693   IF (rectilinear) THEN 
    694     iret = NF90_PUT_ATT (ncid,nlatid,'axis',"Y") 
    695   ENDIF 
    696   iret = NF90_PUT_ATT (ncid,nlatid,'standard_name',"latitude") 
    697   iret = NF90_PUT_ATT (ncid,nlatid,'units',"degrees_north") 
    698   iret = NF90_PUT_ATT (ncid,nlatid,'valid_min', & 
    699  &                     REAL(MINVAL(plat),KIND=4)) 
    700   iret = NF90_PUT_ATT (ncid,nlatid,'valid_max', & 
    701  &                     REAL(MAXVAL(plat),KIND=4)) 
    702   iret = NF90_PUT_ATT (ncid,nlatid,'long_name',"Latitude") 
    703   iret = NF90_PUT_ATT (ncid,nlatid,'nav_model',TRIM(tmp_title)) 
    704 !- 
    705   iret = NF90_ENDDEF (ncid) 
     704  IF (l_dbg) WRITE(*,*) c_nam//" 3.0" 
     705!- 
     706  i_e = 2; 
     707  IF ( (k_typ == 1).OR.(k_typ == 3) ) THEN 
     708    i_s = 2; wmn = MINVAL(y_1d); wmx = MAXVAL(y_1d); 
     709  ELSEIF (k_typ == 2) THEN 
     710    i_s = 1; wmn = MINVAL(y_2d); wmx = MAXVAL(y_2d); 
     711  ENDIF 
     712  iret = NF90_DEF_VAR(nfid,lat_name,NF90_REAL4,dims(i_s:i_e),nlatid) 
     713  IF (k_typ == 1) THEN 
     714    iret = NF90_PUT_ATT(nfid,nlatid,'axis',"Y") 
     715  ENDIF 
     716!- 
     717  iret = NF90_PUT_ATT(nfid,nlatid,'standard_name',"latitude") 
     718  iret = NF90_PUT_ATT(nfid,nlatid,'units',"degrees_north") 
     719  iret = NF90_PUT_ATT(nfid,nlatid,'valid_min',REAL(wmn,KIND=4)) 
     720  iret = NF90_PUT_ATT(nfid,nlatid,'valid_max',REAL(wmx,KIND=4)) 
     721  iret = NF90_PUT_ATT(nfid,nlatid,'long_name',"Latitude") 
     722  iret = NF90_PUT_ATT(nfid,nlatid,'nav_model',TRIM(phtitle)) 
     723!- 
     724  IF (k_typ == 3) THEN 
     725!--- 
     726!-- 3.1 Latitude bounds 
     727!--- 
     728    iret = NF90_PUT_ATT(nfid,nlatid,'bounds',TRIM(latbound_name)) 
     729    iret = NF90_DEF_VAR(nfid,latbound_name,NF90_REAL4,dims_b(1:2),nlatidb) 
     730    iret = NF90_PUT_ATT(nfid,nlatidb,'long_name', & 
     731 &          'Boundaries for coordinate variable '//TRIM(lat_name)) 
     732  ENDIF 
     733!- 
     734  iret = NF90_ENDDEF(nfid) 
    706735!- 
    707736! 4.0 storing the geographical coordinates 
    708737!- 
    709   IF (l_dbg) WRITE(*,*) "histhori_regular 4.0" 
    710 !- 
    711   orix = slab_ori(pfileid,1) 
    712   oriy = slab_ori(pfileid,2) 
    713   par_szx = slab_sz(pfileid,1) 
    714   par_szy = slab_sz(pfileid,2) 
    715 !- 
    716 ! Transfer the longitude 
    717 !- 
    718   IF (rectilinear) THEN 
    719     iret = NF90_PUT_VAR (ncid,nlonid,plon(orix:orix+par_szx-1,1)) 
    720   ELSE 
    721     iret = NF90_PUT_VAR (ncid,nlonid, & 
    722  &           plon(orix:orix+par_szx-1,oriy:oriy+par_szy-1)) 
    723   ENDIF 
    724 !- 
    725 ! Transfer the latitude 
    726 !- 
    727   IF (rectilinear) THEN 
    728     iret = NF90_PUT_VAR (ncid,nlatid,plat(1,oriy:oriy+par_szy-1)) 
    729   ELSE 
    730     iret = NF90_PUT_VAR (ncid,nlatid, & 
    731  &           plat(orix:orix+par_szx-1,oriy:oriy+par_szy-1)) 
    732   ENDIF 
    733 !- 
    734   iret = NF90_REDEF (ncid) 
    735 !------------------------------ 
    736 END SUBROUTINE histhori_regular 
     738  IF (l_dbg) WRITE(*,*) c_nam//" 4.0" 
     739!- 
     740  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN 
     741    o_x = W_F(idf)%slab_ori(1) 
     742    o_y = W_F(idf)%slab_ori(2) 
     743    s_x = W_F(idf)%slab_siz(1) 
     744    s_y = W_F(idf)%slab_siz(2) 
     745!--- 
     746!-- Transfer the longitude and  the latitude 
     747!--- 
     748    IF     (k_typ == 1) THEN 
     749      iret = NF90_PUT_VAR(nfid,nlonid,x_1d(o_x:o_x+s_x-1)) 
     750      iret = NF90_PUT_VAR(nfid,nlatid,y_1d(o_y:o_y+s_y-1)) 
     751    ELSEIF (k_typ == 2) THEN 
     752      iret = NF90_PUT_VAR(nfid,nlonid, & 
     753 &            x_2d(o_x:o_x+s_x-1,o_y:o_y+s_y-1)) 
     754      iret = NF90_PUT_VAR(nfid,nlatid, & 
     755 &            y_2d(o_x:o_x+s_x-1,o_y:o_y+s_y-1)) 
     756    ENDIF 
     757  ELSEIF (k_typ == 3) THEN 
     758!--- 
     759!-- Transfer the longitude and the longitude bounds 
     760!--- 
     761    iret = NF90_PUT_VAR(nfid,nlonid,x_1d(1:pim)) 
     762!--- 
     763    IF (transp) THEN 
     764      bounds_trans = TRANSPOSE(x_bnds) 
     765    ELSE 
     766      bounds_trans = x_bnds 
     767    ENDIF 
     768    iret = NF90_PUT_VAR(nfid,nlonidb,bounds_trans(1:nbbounds,1:pim)) 
     769!--- 
     770!-- Transfer the latitude and the latitude bounds 
     771!--- 
     772    iret = NF90_PUT_VAR(nfid,nlatid,y_1d(1:pim)) 
     773!--- 
     774    IF (transp) THEN 
     775      bounds_trans = TRANSPOSE(y_bnds) 
     776    ELSE 
     777      bounds_trans = y_bnds 
     778    ENDIF 
     779    iret = NF90_PUT_VAR(nfid,nlatidb,bounds_trans(1:nbbounds,1:pim)) 
     780!--- 
     781    DEALLOCATE(bounds_trans) 
     782  ENDIF 
     783!- 
     784  iret = NF90_REDEF(nfid) 
     785!----------------------- 
     786END SUBROUTINE histh_all 
    737787!=== 
    738 SUBROUTINE histhori_irregular & 
    739  &  (pfileid,pim,plon,plon_bounds,plat,plat_bounds, & 
    740  &   phname,phtitle,phid) 
    741 !--------------------------------------------------------------------- 
    742 !- This subroutine is made to declare a new horizontale grid. 
    743 !- It has to have the same number of points as 
    744 !- the original and thus in this routine we will only 
    745 !- add two variable (longitude and latitude). 
    746 !- Any variable in the file can thus point to this pair 
    747 !- through an attribute. This routine is very usefull 
    748 !- to allow staggered grids. 
    749 !- 
    750 !- INPUT 
    751 !- 
    752 !- pfileid     : The id of the file to which the grid should be added 
    753 !- pim         : Size in the longitude direction 
    754 !- plon        : The longitudes 
    755 !- plon_bounds : The boundaries of the grid in longitude 
    756 !- plat        : The latitudes 
    757 !- plat_bounds : Boundaries of the grid in latitude 
    758 !- phname      : The name of grid 
    759 !- phtitle     : The title of the grid 
    760 !- 
    761 !- OUTPUT 
    762 !- 
    763 !- phid    : Id of the created grid 
    764 !--------------------------------------------------------------------- 
    765   IMPLICIT NONE 
    766 !- 
    767   INTEGER,INTENT(IN) :: pfileid,pim 
    768   REAL,DIMENSION(pim),INTENT(IN) :: plon,plat 
    769   REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds 
    770   CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle 
    771   INTEGER,INTENT(OUT) :: phid 
    772 !- 
    773   CHARACTER(LEN=25) :: lon_name,lat_name 
    774   CHARACTER(LEN=30) :: lonbound_name,latbound_name 
    775   CHARACTER(LEN=80) :: tmp_title,tmp_name,longname 
    776   INTEGER :: ndim,dims(2) 
    777   INTEGER :: ndimb,dimsb(2) 
    778   INTEGER :: nbbounds 
    779   INTEGER :: nlonid,nlatid,nlonidb,nlatidb 
    780   INTEGER :: iret,ncid,twoid 
    781   LOGICAL :: transp = .FALSE. 
    782   REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans 
    783   LOGICAL :: l_dbg 
    784 !--------------------------------------------------------------------- 
    785   CALL ipsldbg (old_status=l_dbg) 
    786 !- 
    787 ! 1.0 Check that all fits in the buffers 
    788 !- 
    789   IF (    (pim /= full_size(pfileid,1)) & 
    790     & .OR.(full_size(pfileid,2) /= 1) ) THEN 
    791     CALL ipslerr (3,"histhori", & 
    792    &  'The new horizontal grid does not have the same size', & 
    793    &  'as the one provided to histbeg. This is not yet ', & 
    794    &  'possible in the hist package.') 
    795   ENDIF 
    796 !- 
    797 ! 1.1 Create all the variables needed 
    798 !- 
    799   IF (l_dbg) WRITE(*,*) 'histhori_irregular 1.0' 
    800 !- 
    801   ncid = ncdf_ids(pfileid) 
    802 !- 
    803   IF     (SIZE(plon_bounds,DIM=1) == pim) THEN 
    804     nbbounds = SIZE(plon_bounds,DIM=2) 
    805     transp = .TRUE. 
    806   ELSEIF (SIZE(plon_bounds,DIM=2) == pim) THEN 
    807     nbbounds = SIZE(plon_bounds,DIM=1) 
    808     transp = .FALSE. 
    809   ELSE 
    810     CALL ipslerr (3,"histhori", & 
    811    &  'The boundary variable does not have any axis corresponding', & 
    812    &  'to the size of the longitude or latitude variable', & 
    813    &  '.') 
    814   ENDIF 
    815 !- 
    816   ALLOCATE(bounds_trans(nbbounds,pim)) 
    817 !- 
    818   iret = NF90_DEF_DIM (ncid,'nbnd',nbbounds,twoid) 
    819   ndim = 1 
    820   dims(1) = xid(pfileid) 
    821   ndimb = 2 
    822   dimsb(1:2) = (/ twoid,xid(pfileid) /) 
    823 !- 
    824   tmp_name = phname 
    825   IF (nb_hax(pfileid) == 0) THEN 
    826     lon_name = 'nav_lon' 
    827     lat_name = 'nav_lat' 
    828   ELSE 
    829     lon_name = 'nav_lon_'//TRIM(tmp_name) 
    830     lat_name = 'nav_lat_'//TRIM(tmp_name) 
    831   ENDIF 
    832   lonbound_name = TRIM(lon_name)//'_bounds' 
    833   latbound_name = TRIM(lat_name)//'_bounds' 
    834 !- 
    835 ! 1.2 Save the informations 
    836 !- 
    837   phid =  nb_hax(pfileid)+1 
    838   nb_hax(pfileid) = phid 
    839 !- 
    840   hax_name(pfileid,phid,1:2) = (/ lon_name,lat_name /) 
    841   tmp_title = phtitle 
    842 !- 
    843 ! 2.0 Longitude 
    844 !- 
    845   IF (l_dbg) WRITE(*,*) "histhori_irregular 2.0" 
    846 !- 
    847   iret = NF90_DEF_VAR (ncid,lon_name,NF90_FLOAT,dims(1:ndim),nlonid) 
    848   iret = NF90_PUT_ATT (ncid,nlonid,'standard_name',"longitude") 
    849   iret = NF90_PUT_ATT (ncid,nlonid,'units',"degrees_east") 
    850   iret = NF90_PUT_ATT (ncid,nlonid,'valid_min', & 
    851  &                     REAL(MINVAL(plon),KIND=4)) 
    852   iret = NF90_PUT_ATT (ncid,nlonid,'valid_max', & 
    853  &                     REAL(MAXVAL(plon),KIND=4)) 
    854   iret = NF90_PUT_ATT (ncid,nlonid,'long_name',"Longitude") 
    855   iret = NF90_PUT_ATT (ncid,nlonid,'nav_model',TRIM(tmp_title)) 
    856 !- 
    857 ! 2.1 Longitude bounds 
    858 !- 
    859   iret = NF90_PUT_ATT (ncid,nlonid,'bounds',TRIM(lonbound_name)) 
    860   iret = NF90_DEF_VAR (ncid,lonbound_name,NF90_FLOAT, & 
    861  &                     dimsb(1:ndimb),nlonidb) 
    862   longname = 'Boundaries for coordinate variable '//TRIM(lon_name) 
    863   iret = NF90_PUT_ATT (ncid,nlonidb,'long_name',TRIM(longname)) 
    864 !- 
    865 ! 3.0 Latitude 
    866 !- 
    867   IF (l_dbg) WRITE(*,*) "histhori_irregular 3.0" 
    868 !- 
    869   iret = NF90_DEF_VAR (ncid,lat_name,NF90_FLOAT,dims(1:ndim),nlatid) 
    870   iret = NF90_PUT_ATT (ncid,nlatid,'standard_name',"latitude") 
    871   iret = NF90_PUT_ATT (ncid,nlatid,'units',"degrees_north") 
    872   iret = NF90_PUT_ATT (ncid,nlatid,'valid_min', & 
    873  &                     REAL(MINVAL(plat),KIND=4)) 
    874   iret = NF90_PUT_ATT (ncid,nlatid,'valid_max', & 
    875  &                     REAL(MAXVAL(plat),KIND=4)) 
    876   iret = NF90_PUT_ATT (ncid,nlatid,'long_name',"Latitude") 
    877   iret = NF90_PUT_ATT (ncid,nlatid,'nav_model',TRIM(tmp_title)) 
    878 !- 
    879 ! 3.1 Latitude bounds 
    880 !- 
    881   iret = NF90_PUT_ATT (ncid,nlatid,'bounds',TRIM(latbound_name)) 
    882   iret = NF90_DEF_VAR (ncid,latbound_name,NF90_FLOAT, & 
    883  &                     dimsb(1:ndimb),nlatidb) 
    884   longname = 'Boundaries for coordinate variable '//TRIM(lat_name) 
    885   iret = NF90_PUT_ATT (ncid,nlatidb,'long_name',TRIM(longname)) 
    886 !- 
    887   iret = NF90_ENDDEF (ncid) 
    888 !- 
    889 ! 4.0 storing the geographical coordinates 
    890 !- 
    891   IF (l_dbg) WRITE(*,*) "histhori_irregular 4.0" 
    892 !- 
    893 ! 4.1 Write the longitude 
    894 !- 
    895   iret = NF90_PUT_VAR (ncid,nlonid,plon(1:pim)) 
    896 !- 
    897 ! 4.2 Write the longitude bounds 
    898 !- 
    899   IF (transp) THEN 
    900     bounds_trans = TRANSPOSE(plon_bounds) 
    901   ELSE 
    902     bounds_trans = plon_bounds 
    903   ENDIF 
    904   iret = NF90_PUT_VAR (ncid,nlonidb,bounds_trans(1:nbbounds,1:pim)) 
    905 !- 
    906 ! 4.3 Write the latitude 
    907 !- 
    908   iret = NF90_PUT_VAR (ncid,nlatid,plat(1:pim)) 
    909 !- 
    910 ! 4.4 Write the latitude bounds 
    911 !- 
    912   IF (transp) THEN 
    913     bounds_trans = TRANSPOSE(plat_bounds) 
    914   ELSE 
    915     bounds_trans = plat_bounds 
    916   ENDIF 
    917   iret = NF90_PUT_VAR (ncid,nlatidb,bounds_trans(1:nbbounds,1:pim)) 
    918 !- 
    919   DEALLOCATE(bounds_trans) 
    920 !- 
    921   iret = NF90_REDEF (ncid) 
    922 !-------------------------------- 
    923 END SUBROUTINE histhori_irregular 
    924 !=== 
    925 SUBROUTINE histvert (pfileid,pzaxname,pzaxtitle,pzaxunit, & 
     788SUBROUTINE histvert (idf,pzaxname,pzaxtitle,pzaxunit, & 
    926789 &                   pzsize,pzvalues,pzaxid,pdirect) 
    927790!--------------------------------------------------------------------- 
     
    933796!- INPUT 
    934797!- 
    935 !- pfileid  : ID of the file the variable should be archived in 
     798!- idf      : ID of the file the variable should be archived in 
    936799!- pzaxname : Name of the vertical axis 
    937800!- pzaxtitle: title of the vertical axis 
     
    952815  IMPLICIT NONE 
    953816!- 
    954   INTEGER,INTENT(IN) :: pfileid,pzsize 
     817  INTEGER,INTENT(IN) :: idf,pzsize 
    955818  CHARACTER(LEN=*),INTENT(IN) :: pzaxname,pzaxunit,pzaxtitle 
    956819  REAL,INTENT(IN) :: pzvalues(pzsize) 
     
    960823  INTEGER :: pos,iv,zdimid,zaxid_tmp 
    961824  CHARACTER(LEN=70) :: str71 
    962   CHARACTER(LEN=80) :: str80 
    963825  CHARACTER(LEN=20) :: direction 
    964   INTEGER :: iret,leng,ncid 
     826  INTEGER :: iret,leng,nfid 
    965827  LOGICAL :: l_dbg 
    966828!--------------------------------------------------------------------- 
     
    974836 &                      pzaxname,'---',pzaxunit,'---',pzaxtitle 
    975837!- 
    976 ! - Direction of axis. Can we get if from the user. 
    977 !   If not we put unknown. 
     838! Direction of the vertical axis. Can we get if from the user. 
    978839!- 
    979840  IF (PRESENT(pdirect)) THEN 
     
    986847! Check the consistency of the attribute 
    987848!- 
    988   IF (     (direction /= 'unknown') & 
    989  &    .AND.(direction /= 'up')      & 
    990  &    .AND.(direction /= 'down')   ) THEN 
     849  IF (     PRESENT(pdirect)    & 
     850 &    .AND.(direction /= 'up') & 
     851 &    .AND.(direction /= 'down') ) THEN 
    991852    direction = 'unknown' 
    992     str80 = 'The specified axis was : '//TRIM(direction) 
    993853    CALL ipslerr (2,"histvert",& 
    994    & "The specified direction for the vertical axis is not possible.",& 
    995    & "it is replaced by : unknown",str80) 
    996   ENDIF 
    997 !- 
    998   IF (nb_zax(pfileid)+1 > nb_zax_max) THEN 
     854 & "The specified positive direction for the vertical axis is invalid.",& 
     855 & "The value must be up or down.","The attribute will not be written.") 
     856  ENDIF 
     857!- 
     858  IF (W_F(idf)%n_zax+1 > nb_zax_max) THEN 
    999859    CALL ipslerr (3,"histvert", & 
    1000860   &  'Table of vertical axes too small. You should increase ',& 
     
    1003863  ENDIF 
    1004864!- 
    1005   iv = nb_zax(pfileid) 
     865  iv = W_F(idf)%n_zax 
    1006866  IF (iv > 1) THEN 
    1007     CALL find_str (zax_name(pfileid,1:iv-1),pzaxname,pos) 
     867    CALL find_str (W_F(idf)%zax_name(1:iv-1),pzaxname,pos) 
    1008868  ELSE 
    1009869    pos = 0 
     
    1012872  IF (pos > 0) THEN 
    1013873    WRITE(str71,'("Check variable ",A," in file",I3)') & 
    1014  &    TRIM(pzaxname),pfileid 
     874 &    TRIM(pzaxname),idf 
    1015875    CALL ipslerr (3,"histvert", & 
    1016876 &    "Vertical axis already exists",TRIM(str71), & 
     
    1018878  ENDIF 
    1019879!- 
    1020   iv = nb_zax(pfileid)+1 
     880  iv = W_F(idf)%n_zax+1 
    1021881!- 
    1022882! 2.0 Add the information to the file 
     
    1025885 &  WRITE(*,*) "histvert : 2.0 Add the information to the file" 
    1026886!- 
    1027   ncid = ncdf_ids(pfileid) 
     887  nfid = W_F(idf)%ncfid 
    1028888!- 
    1029889  leng = MIN(LEN_TRIM(pzaxname),20) 
    1030   iret = NF90_DEF_DIM (ncid,pzaxname(1:leng),pzsize,zaxid_tmp) 
    1031   iret = NF90_DEF_VAR (ncid,pzaxname(1:leng),NF90_FLOAT, & 
     890  iret = NF90_DEF_DIM (nfid,pzaxname(1:leng),pzsize,zaxid_tmp) 
     891  iret = NF90_DEF_VAR (nfid,pzaxname(1:leng),NF90_REAL4, & 
    1032892 &                     zaxid_tmp,zdimid) 
    1033   iret = NF90_PUT_ATT (ncid,zdimid,'axis',"Z") 
    1034   iret = NF90_PUT_ATT (ncid,zdimid,'standard_name',"model_level_number") 
     893  iret = NF90_PUT_ATT (nfid,zdimid,'axis',"Z") 
     894  iret = NF90_PUT_ATT (nfid,zdimid,'standard_name',"model_level_number") 
    1035895  leng = MIN(LEN_TRIM(pzaxunit),20) 
    1036896  IF (leng > 0) THEN 
    1037     iret = NF90_PUT_ATT (ncid,zdimid,'units',pzaxunit(1:leng)) 
    1038   ENDIF 
    1039   iret = NF90_PUT_ATT (ncid,zdimid,'positive',TRIM(direction)) 
    1040   iret = NF90_PUT_ATT (ncid,zdimid,'valid_min', & 
     897    iret = NF90_PUT_ATT (nfid,zdimid,'units',pzaxunit(1:leng)) 
     898  ENDIF 
     899  IF (direction /= 'unknown') THEN 
     900    iret = NF90_PUT_ATT (nfid,zdimid,'positive',TRIM(direction)) 
     901  ENDIF 
     902  iret = NF90_PUT_ATT (nfid,zdimid,'valid_min', & 
    1041903 &                     REAL(MINVAL(pzvalues(1:pzsize)),KIND=4)) 
    1042   iret = NF90_PUT_ATT (ncid,zdimid,'valid_max', & 
     904  iret = NF90_PUT_ATT (nfid,zdimid,'valid_max', & 
    1043905 &                     REAL(MAXVAL(pzvalues(1:pzsize)),KIND=4)) 
    1044906  leng = MIN(LEN_TRIM(pzaxname),20) 
    1045   iret = NF90_PUT_ATT (ncid,zdimid,'title',pzaxname(1:leng)) 
     907  iret = NF90_PUT_ATT (nfid,zdimid,'title',pzaxname(1:leng)) 
    1046908  leng = MIN(LEN_TRIM(pzaxtitle),80) 
    1047   iret = NF90_PUT_ATT (ncid,zdimid,'long_name',pzaxtitle(1:leng)) 
    1048 !- 
    1049   iret = NF90_ENDDEF (ncid) 
    1050 !- 
    1051   iret = NF90_PUT_VAR (ncid,zdimid,pzvalues(1:pzsize)) 
    1052 !- 
    1053   iret = NF90_REDEF (ncid) 
     909  iret = NF90_PUT_ATT (nfid,zdimid,'long_name',pzaxtitle(1:leng)) 
     910!- 
     911  iret = NF90_ENDDEF (nfid) 
     912!- 
     913  iret = NF90_PUT_VAR (nfid,zdimid,pzvalues(1:pzsize)) 
     914!- 
     915  iret = NF90_REDEF (nfid) 
    1054916!- 
    1055917!- 3.0 add the information to the common 
     
    1058920  &  WRITE(*,*) "histvert : 3.0 add the information to the common" 
    1059921!- 
    1060   nb_zax(pfileid) = iv 
    1061   zax_size(pfileid,iv) = pzsize 
    1062   zax_name(pfileid,iv) = pzaxname 
    1063   zax_ids(pfileid,iv) = zaxid_tmp 
    1064   pzaxid =  iv 
     922  W_F(idf)%n_zax = iv 
     923  W_F(idf)%zax_size(iv) = pzsize 
     924  W_F(idf)%zax_name(iv) = pzaxname 
     925  W_F(idf)%zax_ids(iv) = zaxid_tmp 
     926  pzaxid = iv 
    1065927!---------------------- 
    1066928END SUBROUTINE histvert 
    1067929!=== 
    1068 SUBROUTINE histdef (pfileid,pvarname,ptitle,punit, & 
    1069  &                  pxsize,pysize,phoriid,pzsize, & 
    1070  &                  par_oriz,par_szz,pzid,        & 
    1071  &                  pnbbyt,popp,pfreq_opp,pfreq_wrt,var_range) 
     930SUBROUTINE histdef & 
     931 &  (idf,pvarname,ptitle,punit, & 
     932 &   pxsize,pysize,phoriid,pzsize,par_oriz,par_szz,pzid, & 
     933 &   xtype,popp,pfreq_opp,pfreq_wrt,var_range,standard_name) 
    1072934!--------------------------------------------------------------------- 
    1073935!- With this subroutine each variable to be archived on the history 
     
    1080942!- INPUT 
    1081943!- 
    1082 !- pfileid  : ID of the file the variable should be archived in 
     944!- idf      : ID of the file the variable should be archived in 
    1083945!- pvarname : Name of the variable, short and easy to remember 
    1084946!- ptitle   : Full name of the variable 
     
    1104966!- pzid     : ID of the vertical axis to use. It has to have 
    1105967!-            the size of the zoom. 
    1106 !- pnbbyt   : Number of bytes on which to store in netCDF (Not opp.) 
     968!- xtype    : External netCDF type (hist_r4/hist_r8) 
    1107969!- popp     : Operation to be performed. The following options 
    1108970!-            exist today : 
     
    1120982  IMPLICIT NONE 
    1121983!- 
    1122   INTEGER,INTENT(IN) :: pfileid,pxsize,pysize,pzsize,pzid 
    1123   INTEGER,INTENT(IN) :: par_oriz,par_szz,pnbbyt,phoriid 
     984  INTEGER,INTENT(IN) :: idf,pxsize,pysize,pzsize,pzid 
     985  INTEGER,INTENT(IN) :: par_oriz,par_szz,xtype,phoriid 
    1124986  CHARACTER(LEN=*),INTENT(IN) :: pvarname,punit,popp,ptitle 
    1125987  REAL,INTENT(IN) :: pfreq_opp,pfreq_wrt 
    1126988  REAL,DIMENSION(2),OPTIONAL,INTENT(IN) :: var_range 
    1127 !- 
    1128   INTEGER :: iv,i 
     989  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: standard_name 
     990!- 
     991  INTEGER :: iv 
    1129992  CHARACTER(LEN=70) :: str70,str71,str72 
    1130993  CHARACTER(LEN=20) :: tmp_name 
    1131994  CHARACTER(LEN=40) :: str40 
    1132995  CHARACTER(LEN=10) :: str10 
    1133   CHARACTER(LEN=80) :: tmp_str80 
    1134   CHARACTER(LEN=7) :: tmp_topp,tmp_sopp(nbopp_max) 
    1135996  CHARACTER(LEN=120) :: ex_topps 
    1136   REAL :: tmp_scal(nbopp_max),un_an,un_jour,test_fopp,test_fwrt 
     997  REAL :: un_an,un_jour,test_fopp,test_fwrt 
    1137998  INTEGER :: pos,buff_sz 
    1138999  LOGICAL :: l_dbg 
     
    11421003  ex_topps = 'ave, inst, t_min, t_max, t_sum, once, never, l_max, l_min' 
    11431004!- 
    1144   nb_var(pfileid) = nb_var(pfileid)+1 
    1145   iv = nb_var(pfileid) 
     1005  W_F(idf)%n_var = W_F(idf)%n_var+1 
     1006  iv = W_F(idf)%n_var 
    11461007!- 
    11471008  IF (iv > nb_var_max) THEN 
     
    11581019!- 
    11591020  IF (iv > 1) THEN 
    1160     CALL find_str (name(pfileid,1:iv-1),pvarname,pos) 
     1021    CALL find_str (W_F(idf)%W_V(1:iv-1)%v_name,pvarname,pos) 
    11611022  ELSE 
    11621023    pos = 0 
     
    11661027    str70 = "Variable already exists" 
    11671028    WRITE(str71,'("Check variable  ",a," in file",I3)') & 
    1168  &    TRIM(pvarname),pfileid 
     1029 &    TRIM(pvarname),idf 
    11691030    str72 = "Can also be a wrong file ID in another declaration" 
    11701031    CALL ipslerr (3,"histdef",str70,str71,str72) 
    11711032  ENDIF 
    11721033!- 
    1173   name(pfileid,iv) = pvarname 
    1174   title(pfileid,iv) = ptitle 
    1175   unit_name(pfileid,iv) = punit 
    1176   tmp_name =  name(pfileid,iv) 
     1034  W_F(idf)%W_V(iv)%v_name = pvarname 
     1035  W_F(idf)%W_V(iv)%title = ptitle 
     1036  W_F(idf)%W_V(iv)%unit_name = punit 
     1037  IF (PRESENT(standard_name)) THEN 
     1038    W_F(idf)%W_V(iv)%std_name = standard_name 
     1039  ELSE 
     1040    W_F(idf)%W_V(iv)%std_name = ptitle 
     1041  ENDIF 
     1042  tmp_name = W_F(idf)%W_V(iv)%v_name 
    11771043!- 
    11781044! 1.1 decode the operations 
    11791045!- 
    1180   fullop(pfileid,iv) = popp 
    1181   tmp_str80 = popp 
     1046  W_F(idf)%W_V(iv)%fullop = popp 
    11821047  CALL buildop & 
    1183  &  (tmp_str80,ex_topps,tmp_topp,nbopp_max,missing_val, & 
    1184  &   tmp_sopp,tmp_scal,nbopp(pfileid,iv)) 
    1185 !- 
    1186   topp(pfileid,iv) = tmp_topp 
    1187   DO i=1,nbopp(pfileid,iv) 
    1188     sopps(pfileid,iv,i) = tmp_sopp(i) 
    1189     scal(pfileid,iv,i) = tmp_scal(i) 
    1190   ENDDO 
     1048 &  (TRIM(popp),ex_topps,W_F(idf)%W_V(iv)%topp,missing_val, & 
     1049 &   W_F(idf)%W_V(iv)%sopp,W_F(idf)%W_V(iv)%scal, & 
     1050 &   W_F(idf)%W_V(iv)%nbopp) 
    11911051!- 
    11921052! 1.2 If we have an even number of operations 
    11931053!     then we need to add identity 
    11941054!- 
    1195   IF (2*INT(nbopp(pfileid,iv)/2.0) == nbopp(pfileid,iv)) THEN 
    1196     nbopp(pfileid,iv) = nbopp(pfileid,iv)+1 
    1197     sopps(pfileid,iv,nbopp(pfileid,iv)) = 'ident' 
    1198     scal(pfileid,iv,nbopp(pfileid,iv)) = missing_val 
     1055  IF ( MOD(W_F(idf)%W_V(iv)%nbopp,2) == 0) THEN 
     1056    W_F(idf)%W_V(iv)%nbopp = W_F(idf)%W_V(iv)%nbopp+1 
     1057    W_F(idf)%W_V(iv)%sopp(W_F(idf)%W_V(iv)%nbopp) = 'ident' 
     1058    W_F(idf)%W_V(iv)%scal(W_F(idf)%W_V(iv)%nbopp) = missing_val 
     1059  ENDIF 
     1060!- 
     1061! 1.3 External type of the variable 
     1062!- 
     1063  IF (xtype == hist_r8) THEN 
     1064    W_F(idf)%W_V(iv)%v_typ = hist_r8 
     1065  ELSE 
     1066    W_F(idf)%W_V(iv)%v_typ = hist_r4 
    11991067  ENDIF 
    12001068!- 
    12011069! 2.0 Put the size of the variable in the common and check 
    12021070!- 
    1203   IF (l_dbg) & 
    1204  &  WRITE(*,*) "histdef : 2.0",pfileid,iv,nbopp(pfileid,iv), & 
    1205  &    sopps(pfileid,iv,1:nbopp(pfileid,iv)), & 
    1206  &    scal(pfileid,iv,1:nbopp(pfileid,iv)) 
    1207 !- 
    1208   scsize(pfileid,iv,1:3) = (/ pxsize,pysize,pzsize /) 
    1209 !- 
    1210   zorig(pfileid,iv,1:3) = & 
    1211  &  (/ slab_ori(pfileid,1),slab_ori(pfileid,2),par_oriz /) 
    1212 !- 
    1213   zsize(pfileid,iv,1:3) = & 
    1214  &  (/ slab_sz(pfileid,1),slab_sz(pfileid,2),par_szz /) 
    1215 !- 
    1216 ! Is the size of the full array the same as that of the coordinates  ? 
    1217 !- 
    1218   IF (    (pxsize > full_size(pfileid,1)) & 
    1219  &    .OR.(pysize > full_size(pfileid,2)) ) THEN 
     1071  IF (l_dbg) THEN 
     1072    WRITE(*,*) "histdef : 2.0",idf,iv,W_F(idf)%W_V(iv)%nbopp, & 
     1073 &    W_F(idf)%W_V(iv)%sopp(1:W_F(idf)%W_V(iv)%nbopp), & 
     1074 &    W_F(idf)%W_V(iv)%scal(1:W_F(idf)%W_V(iv)%nbopp) 
     1075  ENDIF 
     1076!- 
     1077  W_F(idf)%W_V(iv)%scsize(1:3) = (/ pxsize,pysize,pzsize /) 
     1078  W_F(idf)%W_V(iv)%zorig(1:3) = & 
     1079 &  (/ W_F(idf)%slab_ori(1),W_F(idf)%slab_ori(2),par_oriz /) 
     1080  W_F(idf)%W_V(iv)%zsize(1:3) = & 
     1081 &  (/ W_F(idf)%slab_siz(1),W_F(idf)%slab_siz(2),par_szz /) 
     1082!- 
     1083! Is the size of the full array the same as that of the coordinates ? 
     1084!- 
     1085  IF (    (pxsize > W_F(idf)%full_size(1)) & 
     1086 &    .OR.(pysize > W_F(idf)%full_size(2)) ) THEN 
    12201087!- 
    12211088    str70 = "The size of the variable is different "// & 
    12221089 &          "from the one of the coordinates" 
    12231090    WRITE(str71,'("Size of coordinates :",2I4)') & 
    1224  &   full_size(pfileid,1),full_size(pfileid,2) 
     1091 &   W_F(idf)%full_size(1),W_F(idf)%full_size(2) 
    12251092    WRITE(str72,'("Size declared for variable ",a," :",2I4)') & 
    12261093 &   TRIM(tmp_name),pxsize,pysize 
     
    12281095  ENDIF 
    12291096!- 
    1230 ! Is the size of the zoom smaler than the coordinates ? 
    1231 !- 
    1232   IF (    (full_size(pfileid,1) < slab_sz(pfileid,1)) & 
    1233  &    .OR.(full_size(pfileid,2) < slab_sz(pfileid,2)) ) THEN 
     1097! Is the size of the zoom smaller than the coordinates ? 
     1098!- 
     1099  IF (    (W_F(idf)%full_size(1) < W_F(idf)%slab_siz(1)) & 
     1100 &    .OR.(W_F(idf)%full_size(2) < W_F(idf)%slab_siz(2)) ) THEN 
    12341101    str70 = & 
    12351102 &   "Size of variable should be greater or equal to those of the zoom" 
    12361103    WRITE(str71,'("Size of XY zoom :",2I4)') & 
    1237  &   slab_sz(pfileid,1),slab_sz(pfileid,1) 
    1238     WRITE(str72,'("Size declared for variable ",a," :",2I4)') & 
     1104 &   W_F(idf)%slab_siz(1),W_F(idf)%slab_siz(2) 
     1105    WRITE(str72,'("Size declared for variable ",A," :",2I4)') & 
    12391106 &   TRIM(tmp_name),pxsize,pysize 
    12401107    CALL ipslerr (3,"histdef",str70,str71,str72) 
     
    12441111!     and a fall back onto the default grid 
    12451112!- 
    1246   IF ( (phoriid > 0).AND.(phoriid <= nb_hax(pfileid)) ) THEN 
    1247     var_haxid(pfileid,iv) = phoriid 
     1113  IF ( (phoriid > 0).AND.(phoriid <= W_F(idf)%n_hax) ) THEN 
     1114    W_F(idf)%W_V(iv)%h_axid = phoriid 
    12481115  ELSE 
    1249     var_haxid(pfileid,iv) = 1 
     1116    W_F(idf)%W_V(iv)%h_axid = 1 
    12501117    CALL ipslerr (2,"histdef", & 
    12511118   &  'We use the default grid for variable as an invalide',& 
     
    12591126!-- Does the vertical coordinate exist ? 
    12601127!- 
    1261     IF (pzid > nb_zax(pfileid)) THEN 
     1128    IF (pzid > W_F(idf)%n_zax) THEN 
    12621129      WRITE(str70, & 
    1263  &    '("The vertical coordinate chosen for variable ",a)') & 
     1130 &    '("The vertical coordinate chosen for variable ",A)') & 
    12641131 &     TRIM(tmp_name) 
    12651132      str71 = " Does not exist." 
     
    12691136!-- Is the vertical size of the variable equal to that of the axis ? 
    12701137!- 
    1271     IF (par_szz /= zax_size(pfileid,pzid)) THEN 
     1138    IF (par_szz /= W_F(idf)%zax_size(pzid)) THEN 
    12721139      str70 = "The size of the zoom does not correspond "// & 
    12731140 &            "to the size of the chosen vertical axis" 
    12741141      WRITE(str71,'("Size of zoom in z :",I4)') par_szz 
    12751142      WRITE(str72,'("Size declared for axis ",A," :",I4)') & 
    1276  &     TRIM(zax_name(pfileid,pzid)),zax_size(pfileid,pzid) 
     1143 &     TRIM(W_F(idf)%zax_name(pzid)),W_F(idf)%zax_size(pzid) 
    12771144      CALL ipslerr (3,"histdef",str70,str71,str72) 
    12781145    ENDIF 
    12791146!- 
    1280 !-- Is the zoom smaler that the total size of the variable ? 
     1147!-- Is the zoom smaller that the total size of the variable ? 
    12811148!- 
    12821149    IF (pzsize < par_szz) THEN 
     
    12881155      CALL ipslerr (3,"histdef",str70,str71,str72) 
    12891156    ENDIF 
    1290     var_zaxid(pfileid,iv) = pzid 
     1157    W_F(idf)%W_V(iv)%z_axid = pzid 
    12911158  ELSE 
    1292     var_zaxid(pfileid,iv) = -99 
    1293   ENDIF 
    1294 !- 
    1295 ! 3.0 Determine the position of the variable in the buffer 
    1296 !     If it is instantaneous output then we do not use the buffer 
    1297 !- 
    1298   IF (l_dbg) WRITE(*,*) "histdef : 3.0" 
    1299 !- 
    1300 ! 3.1 We get the size of the arrays histwrite will get and check 
    1301 !     that they fit into the tmp_buffer 
    1302 !- 
    1303   buff_sz = zsize(pfileid,iv,1)*zsize(pfileid,iv,2)*zsize(pfileid,iv,3) 
    1304 !- 
    1305 ! 3.2 move the pointer of the buffer array for operation 
    1306 !     which need bufferisation 
    1307 !- 
    1308   IF (     (TRIM(tmp_topp) /= "inst") & 
    1309  &    .AND.(TRIM(tmp_topp) /= "once") & 
    1310  &    .AND.(TRIM(tmp_topp) /= "never") )THEN 
    1311     point(pfileid,iv) = buff_pos+1 
    1312     buff_pos = buff_pos+buff_sz 
     1159    W_F(idf)%W_V(iv)%z_axid = -99 
     1160  ENDIF 
     1161!- 
     1162! 3.0 We get the size of the arrays histwrite will get 
     1163!     and eventually allocate the time_buffer 
     1164!- 
     1165  IF (l_dbg) THEN 
     1166    WRITE(*,*) "histdef : 3.0" 
     1167  ENDIF 
     1168!- 
     1169  buff_sz = W_F(idf)%W_V(iv)%zsize(1) & 
     1170 &         *W_F(idf)%W_V(iv)%zsize(2) & 
     1171 &         *W_F(idf)%W_V(iv)%zsize(3) 
     1172!- 
     1173  IF (     (TRIM(W_F(idf)%W_V(iv)%topp) /= "inst") & 
     1174 &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "once") & 
     1175 &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "never") )THEN 
     1176    ALLOCATE(W_F(idf)%W_V(iv)%t_bf(buff_sz)) 
     1177    W_F(idf)%W_V(iv)%t_bf(:) = 0. 
    13131178    IF (l_dbg) THEN 
    1314       WRITE(*,*) "histdef : 3.2 bufpos for iv = ",iv, & 
    1315  &               " pfileid = ",pfileid," is = ",point(pfileid,iv) 
     1179      WRITE(*,*) "histdef : 3.0 allocating time_buffer for", & 
     1180 &      " idf = ",idf," iv = ",iv," size = ",buff_sz 
    13161181    ENDIF 
    13171182  ENDIF 
     
    13241189  IF (l_dbg) WRITE(*,*) "histdef : 4.0" 
    13251190!- 
    1326   freq_opp(pfileid,iv) = pfreq_opp 
    1327   freq_wrt(pfileid,iv) = pfreq_wrt 
     1191  W_F(idf)%W_V(iv)%freq_opp = pfreq_opp 
     1192  W_F(idf)%W_V(iv)%freq_wrt = pfreq_wrt 
    13281193!- 
    13291194  CALL ioget_calendar(un_an,un_jour) 
     
    13431208! 4.1 Frequency of operations and output should be larger than deltat ! 
    13441209!- 
    1345   IF (test_fopp < deltat(pfileid)) THEN 
     1210  IF (test_fopp < W_F(idf)%deltat) THEN 
    13461211    str70 = 'Frequency of operations should be larger than deltat' 
    13471212    WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') & 
     
    13511216    CALL ipslerr (2,"histdef",str70,str71,str72) 
    13521217!- 
    1353     freq_opp(pfileid,iv) = deltat(pfileid) 
    1354   ENDIF 
    1355 !- 
    1356   IF (test_fwrt < deltat(pfileid)) THEN 
     1218    W_F(idf)%W_V(iv)%freq_opp = W_F(idf)%deltat 
     1219  ENDIF 
     1220!- 
     1221  IF (test_fwrt < W_F(idf)%deltat) THEN 
    13571222    str70 = 'Frequency of output should be larger than deltat' 
    13581223    WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') & 
     
    13621227    CALL ipslerr (2,"histdef",str70,str71,str72) 
    13631228!- 
    1364     freq_wrt(pfileid,iv) = deltat(pfileid) 
     1229    W_F(idf)%W_V(iv)%freq_wrt = W_F(idf)%deltat 
    13651230  ENDIF 
    13661231!- 
     
    13681233!     its compaticility with the choice of frequencies 
    13691234!- 
    1370   IF (TRIM(tmp_topp) == "inst") THEN 
     1235  IF (TRIM(W_F(idf)%W_V(iv)%topp) == "inst") THEN 
    13711236    IF (test_fopp /= test_fwrt) THEN 
    13721237      str70 = 'For instantaneous output the frequency '// & 
     
    13781243      CALL ipslerr (2,"histdef",str70,str71,str72) 
    13791244      IF (test_fopp < test_fwrt) THEN 
    1380         freq_opp(pfileid,iv) = pfreq_opp 
    1381         freq_wrt(pfileid,iv) = pfreq_opp 
     1245        W_F(idf)%W_V(iv)%freq_opp = pfreq_opp 
     1246        W_F(idf)%W_V(iv)%freq_wrt = pfreq_opp 
    13821247      ELSE 
    1383         freq_opp(pfileid,iv) = pfreq_wrt 
    1384         freq_wrt(pfileid,iv) = pfreq_wrt 
     1248        W_F(idf)%W_V(iv)%freq_opp = pfreq_wrt 
     1249        W_F(idf)%W_V(iv)%freq_wrt = pfreq_wrt 
    13851250      ENDIF 
    13861251    ENDIF 
    1387   ELSE IF (INDEX(ex_topps,TRIM(tmp_topp)) > 0) THEN 
     1252  ELSE IF (INDEX(ex_topps,TRIM(W_F(idf)%W_V(iv)%topp)) > 0) THEN 
    13881253    IF (test_fopp > test_fwrt) THEN 
    13891254      str70 = 'For averages the frequency of operations '// & 
    1390 &             'should be smaller or equal' 
     1255 &            'should be smaller or equal' 
    13911256      WRITE(str71, & 
    13921257 &     '("to that of output. It is not the case for variable ",a)') & 
     
    13941259      str72 = 'PATCH : The output frequency is used for both' 
    13951260      CALL ipslerr (2,"histdef",str70,str71,str72) 
    1396       freq_opp(pfileid,iv) = pfreq_wrt 
     1261      W_F(idf)%W_V(iv)%freq_opp = pfreq_wrt 
    13971262    ENDIF 
    13981263  ELSE 
    1399     WRITE (str70,'("Operation on variable ",a," is unknown")') & 
    1400 &    TRIM(tmp_name) 
    1401     WRITE (str71,'("operation requested is :",a)') tmp_topp 
    1402     WRITE (str72,'("File ID :",I3)') pfileid 
     1264    WRITE (str70,'("Operation on variable ",A," is unknown")') & 
     1265 &   TRIM(tmp_name) 
     1266    WRITE (str71,'("operation requested is :",A)') & 
     1267 &   W_F(idf)%W_V(iv)%topp 
     1268    WRITE (str72,'("File ID :",I3)') idf 
    14031269    CALL ipslerr (3,"histdef",str70,str71,str72) 
    14041270  ENDIF 
     
    14081274  IF (l_dbg) WRITE(*,*) "histdef : 5.0" 
    14091275!- 
    1410   hist_wrt_rng(pfileid,iv) = (PRESENT(var_range)) 
    1411   IF (hist_wrt_rng(pfileid,iv)) THEN 
    1412     hist_calc_rng(pfileid,iv) = (var_range(1) > var_range(2)) 
    1413     IF (hist_calc_rng(pfileid,iv)) THEN 
    1414       hist_minmax(pfileid,iv,1:2) = & 
     1276  W_F(idf)%W_V(iv)%hist_wrt_rng = (PRESENT(var_range)) 
     1277  IF (W_F(idf)%W_V(iv)%hist_wrt_rng) THEN 
     1278    W_F(idf)%W_V(iv)%hist_calc_rng = (var_range(1) > var_range(2)) 
     1279    IF (W_F(idf)%W_V(iv)%hist_calc_rng) THEN 
     1280      W_F(idf)%W_V(iv)%hist_minmax(1:2) = & 
    14151281 &      (/ ABS(missing_val),-ABS(missing_val) /) 
    14161282    ELSE 
    1417       hist_minmax(pfileid,iv,1:2) = var_range(1:2) 
    1418     ENDIF 
    1419   ENDIF 
    1420 !- 
    1421 ! - freq_opp(pfileid,iv)/2./deltat(pfileid) 
    1422   last_opp(pfileid,iv) = itau0(pfileid) 
    1423 ! - freq_wrt(pfileid,iv)/2./deltat(pfileid) 
    1424   last_wrt(pfileid,iv) = itau0(pfileid) 
    1425 ! - freq_opp(pfileid,iv)/2./deltat(pfileid) 
    1426   last_opp_chk(pfileid,iv) = itau0(pfileid) 
    1427 ! - freq_wrt(pfileid,iv)/2./deltat(pfileid) 
    1428   last_wrt_chk(pfileid,iv) = itau0(pfileid) 
    1429   nb_opp(pfileid,iv) = 0 
    1430   nb_wrt(pfileid,iv) = 0 
     1283      W_F(idf)%W_V(iv)%hist_minmax(1:2) = var_range(1:2) 
     1284    ENDIF 
     1285  ENDIF 
     1286!- 
     1287! - freq_opp(idf,iv)/2./deltat(idf) 
     1288  W_F(idf)%W_V(iv)%last_opp = W_F(idf)%itau0 
     1289! - freq_wrt(idf,iv)/2./deltat(idf) 
     1290  W_F(idf)%W_V(iv)%last_wrt = W_F(idf)%itau0 
     1291! - freq_opp(idf,iv)/2./deltat(idf) 
     1292  W_F(idf)%W_V(iv)%last_opp_chk = W_F(idf)%itau0 
     1293! - freq_wrt(idf,iv)/2./deltat(idf) 
     1294  W_F(idf)%W_V(iv)%last_wrt_chk = W_F(idf)%itau0 
     1295  W_F(idf)%W_V(iv)%nb_opp = 0 
     1296  W_F(idf)%W_V(iv)%nb_wrt = 0 
    14311297!- 
    14321298! 6.0 Get the time axis for this variable 
     
    14341300  IF (l_dbg) WRITE(*,*) "histdef : 6.0" 
    14351301!- 
    1436   IF (freq_wrt(pfileid,iv) > 0) THEN 
    1437     WRITE(str10,'(I8.8)') INT(freq_wrt(pfileid,iv)) 
    1438     str40 = TRIM(tmp_topp)//"_"//TRIM(str10) 
     1302! No time axis for once, l_max, l_min or never operation 
     1303!- 
     1304  IF (     (TRIM(W_F(idf)%W_V(iv)%topp) /= 'once')  & 
     1305 &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'never') & 
     1306 &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'l_max') & 
     1307 &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'l_min') ) THEN 
     1308    IF (TRIM(W_F(idf)%W_V(iv)%topp) == 'inst') THEN 
     1309      str10 = 't_inst_' 
     1310    ELSE 
     1311      str10 = 't_op_' 
     1312    ENDIF 
     1313    IF (W_F(idf)%W_V(iv)%freq_wrt > 0) THEN 
     1314      WRITE (UNIT=str40,FMT='(A,I8.8)') & 
     1315&      TRIM(str10),INT(W_F(idf)%W_V(iv)%freq_wrt) 
     1316    ELSE 
     1317      WRITE (UNIT=str40,FMT='(A,I2.2,"month")') & 
     1318&      TRIM(str10),ABS(INT(W_F(idf)%W_V(iv)%freq_wrt)) 
     1319    ENDIF 
     1320    CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_tax)%tax_name,str40,pos) 
     1321    IF (pos < 0) THEN 
     1322      W_F(idf)%n_tax = W_F(idf)%n_tax+1 
     1323      W_F(idf)%W_V(iv)%l_bnd = & 
     1324 &      (TRIM(W_F(idf)%W_V(iv)%topp) /= 'inst') 
     1325      W_F(idf)%W_V(W_F(idf)%n_tax)%tax_name = str40 
     1326      W_F(idf)%W_V(W_F(idf)%n_tax)%tax_last = 0 
     1327      W_F(idf)%W_V(iv)%t_axid = W_F(idf)%n_tax 
     1328    ELSE 
     1329      W_F(idf)%W_V(iv)%t_axid = pos 
     1330    ENDIF 
    14391331  ELSE 
    1440     WRITE(str10,'(I2.2,"month")') ABS(INT(freq_wrt(pfileid,iv))) 
    1441     str40 = TRIM(tmp_topp)//"_"//TRIM(str10) 
    1442   ENDIF 
    1443   CALL find_str (tax_name(pfileid,1:nb_tax(pfileid)),str40,pos) 
    1444 !- 
    1445 ! No time axis for once, l_max, l_min or never operation 
    1446 !- 
    1447   IF (     (TRIM(tmp_topp) /= 'once')  & 
    1448  &    .AND.(TRIM(tmp_topp) /= 'never') & 
    1449  &    .AND.(TRIM(tmp_topp) /= 'l_max') & 
    1450  &    .AND.(TRIM(tmp_topp) /= 'l_min') ) THEN 
    1451     IF (pos < 0) THEN 
    1452       nb_tax(pfileid) = nb_tax(pfileid)+1 
    1453       tax_name(pfileid,nb_tax(pfileid)) = str40 
    1454       tax_last(pfileid,nb_tax(pfileid)) = 0 
    1455       var_axid(pfileid,iv) = nb_tax(pfileid) 
    1456     ELSE 
    1457       var_axid(pfileid,iv) = pos 
    1458     ENDIF 
    1459   ELSE 
    1460     IF (l_dbg)   WRITE(*,*) "histdef : 7.0 ",TRIM(tmp_topp),'----' 
    1461     var_axid(pfileid,iv) = -99 
     1332    IF (l_dbg) THEN 
     1333      WRITE(*,*) "histdef : 7.0 ",TRIM(W_F(idf)%W_V(iv)%topp),'----' 
     1334    ENDIF 
     1335    W_F(idf)%W_V(iv)%t_axid = -99 
    14621336  ENDIF 
    14631337!- 
     
    14651339!     for never or once operation 
    14661340!- 
    1467   IF (    (TRIM(tmp_topp) == 'once')  & 
    1468  &    .OR.(TRIM(tmp_topp) == 'never') ) THEN 
    1469     freq_opp(pfileid,iv) = 0. 
    1470     freq_wrt(pfileid,iv) = 0. 
     1341  IF (    (TRIM(W_F(idf)%W_V(iv)%topp) == 'once')  & 
     1342 &    .OR.(TRIM(W_F(idf)%W_V(iv)%topp) == 'never') ) THEN 
     1343    W_F(idf)%W_V(iv)%freq_opp = 0. 
     1344    W_F(idf)%W_V(iv)%freq_wrt = 0. 
    14711345  ENDIF 
    14721346!--------------------- 
    14731347END SUBROUTINE histdef 
    14741348!=== 
    1475 SUBROUTINE histend (pfileid) 
     1349SUBROUTINE histend (idf) 
    14761350!--------------------------------------------------------------------- 
    14771351!- This subroutine end the decalaration of variables and sets the 
     
    14801354!- INPUT 
    14811355!- 
    1482 !- pfileid : ID of the file to be worked on 
     1356!- idf : ID of the file to be worked on 
    14831357!- 
    14841358!- VERSION 
     
    14871361  IMPLICIT NONE 
    14881362!- 
    1489   INTEGER,INTENT(IN) :: pfileid 
    1490 !- 
    1491   INTEGER :: ncid,ncvarid,iret,ndim,iv,itx,ziv,itax,dim_cnt 
     1363  INTEGER,INTENT(IN) :: idf 
     1364!- 
     1365  INTEGER :: nfid,nvid,iret,ndim,iv,itx,ziv,itax,dim_cnt 
    14921366  INTEGER,DIMENSION(4) :: dims 
    14931367  INTEGER :: year,month,day,hours,minutes 
     
    14951369  REAL :: rtime0 
    14961370  CHARACTER(LEN=30) :: str30 
     1371  CHARACTER(LEN=35) :: str35 
    14971372  CHARACTER(LEN=120) :: assoc 
    14981373  CHARACTER(LEN=70) :: str70 
     
    15011376 &     'JUL','AUG','SEP','OCT','NOV','DEC' /) 
    15021377  CHARACTER(LEN=7) :: tmp_opp 
     1378  LOGICAL :: l_b 
    15031379  LOGICAL :: l_dbg 
    15041380!--------------------------------------------------------------------- 
    15051381  CALL ipsldbg (old_status=l_dbg) 
    15061382!- 
    1507   ncid = ncdf_ids(pfileid) 
     1383  nfid = W_F(idf)%ncfid 
    15081384!- 
    15091385! 1.0 Create the time axes 
    15101386!- 
    15111387  IF (l_dbg) WRITE(*,*) "histend : 1.0" 
    1512 !--- 
    1513   iret = NF90_DEF_DIM (ncid,'time_counter',NF90_UNLIMITED,tid(pfileid)) 
    1514 !- 
    1515 ! 1.1 Define all the time axes needed for this file 
    1516 !- 
    1517   DO itx=1,nb_tax(pfileid) 
    1518     dims(1) = tid(pfileid) 
    1519     IF (nb_tax(pfileid) > 1) THEN 
    1520       str30 = "t_"//tax_name(pfileid,itx) 
     1388!- 
     1389! 1.1 Define the time dimensions needed for this file 
     1390!- 
     1391  iret = NF90_DEF_DIM (nfid,'time_counter', & 
     1392 &                     NF90_UNLIMITED,W_F(idf)%tid) 
     1393  DO iv=1,W_F(idf)%n_var 
     1394    IF (W_F(idf)%W_V(iv)%l_bnd) THEN 
     1395      iret = NF90_DEF_DIM (nfid,'tbnds',2,W_F(idf)%bid) 
     1396      EXIT 
     1397    ENDIF 
     1398  ENDDO 
     1399!- 
     1400! 1.2 Define all the time axes needed for this file 
     1401!- 
     1402  DO itx=1,W_F(idf)%n_tax 
     1403    dims(1) = W_F(idf)%tid 
     1404    l_b = (INDEX(W_F(idf)%W_V(itx)%tax_name,"t_op_") == 1) 
     1405    IF (itx > 1) THEN 
     1406      str30 = W_F(idf)%W_V(itx)%tax_name 
    15211407    ELSE 
    15221408      str30 = "time_counter" 
    15231409    ENDIF 
    1524     iret = NF90_DEF_VAR (ncid,str30,NF90_DOUBLE, & 
    1525  &                       dims(1),tdimid(pfileid,itx)) 
    1526     IF (nb_tax(pfileid) <= 1) THEN 
    1527       iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'axis',"T") 
    1528     ENDIF 
    1529     iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'standard_name',"time") 
     1410    IF (l_b) THEN 
     1411      str35 = TRIM(str30)//'_bnds' 
     1412    ENDIF 
     1413    iret = NF90_DEF_VAR (nfid,TRIM(str30),NF90_REAL8, & 
     1414 &          dims(1),W_F(idf)%W_V(itx)%tdimid) 
     1415    IF (itx <= 1) THEN 
     1416      iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid,'axis',"T") 
     1417    ENDIF 
     1418    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, & 
     1419 &          'standard_name',"time") 
    15301420!--- 
    15311421!   To transform the current itau into a real date and take it 
     
    15351425!   if there is a ioconf routine to control it. 
    15361426!--- 
    1537 !-- rtime0 = itau2date(itau0(pfileid),date0(pfileid),deltat(pfileid)) 
    1538     rtime0 = date0(pfileid) 
     1427!-- rtime0 = itau2date(itau0(idf),date0(idf),deltat(idf)) 
     1428    rtime0 = W_F(idf)%date0 
    15391429!- 
    15401430    CALL ju2ymds(rtime0,year,month,day,sec) 
     
    15531443 &   FMT='(A,I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') & 
    15541444 &    'seconds since ',year,month,day,hours,minutes,INT(sec) 
    1555     iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'units',TRIM(str70)) 
     1445    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, & 
     1446 &           'units',TRIM(str70)) 
    15561447!- 
    15571448    CALL ioget_calendar (str30) 
    1558     iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx), & 
    1559  &                       'calendar',TRIM(str30)) 
    1560 !- 
    1561     iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'title','Time') 
    1562 !- 
    1563     iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx), & 
    1564  &                       'long_name','Time axis') 
     1449    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, & 
     1450 &           'calendar',TRIM(str30)) 
     1451!- 
     1452    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, & 
     1453 &           'title','Time') 
     1454!- 
     1455    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, & 
     1456 &           'long_name','Time axis') 
    15651457!- 
    15661458    WRITE (UNIT=str70, & 
    15671459 &   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') & 
    15681460 &    year,cal(month),day,hours,minutes,INT(sec) 
    1569     iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx), & 
    1570  &                       'time_origin',TRIM(str70)) 
     1461    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, & 
     1462 &           'time_origin',TRIM(str70)) 
     1463!--- 
     1464    IF (l_b) THEN 
     1465      iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, & 
     1466 &             'bounds',TRIM(str35)) 
     1467      dims(1:2) = (/ W_F(idf)%bid,W_F(idf)%tid /) 
     1468      iret = NF90_DEF_VAR (nfid,TRIM(str35),NF90_REAL8, & 
     1469 &            dims(1:2),W_F(idf)%W_V(itx)%tbndid) 
     1470    ENDIF 
    15711471  ENDDO 
    15721472!- 
     
    15751475  IF (l_dbg) WRITE(*,*) "histend : 2.0" 
    15761476!- 
    1577   DO iv=1,nb_var(pfileid) 
    1578 !--- 
    1579     itax = var_axid(pfileid,iv) 
    1580 !--- 
    1581     IF (regular(pfileid) ) THEN 
    1582       dims(1:2) = (/ xid(pfileid),yid(pfileid) /) 
     1477  DO iv=1,W_F(idf)%n_var 
     1478!--- 
     1479    itax = W_F(idf)%W_V(iv)%t_axid 
     1480!--- 
     1481    IF (W_F(idf)%regular) THEN 
     1482      dims(1:2) = (/ W_F(idf)%xid,W_F(idf)%yid /) 
    15831483      dim_cnt = 2 
    15841484    ELSE 
    1585       dims(1) = xid(pfileid) 
     1485      dims(1) = W_F(idf)%xid 
    15861486      dim_cnt = 1 
    15871487    ENDIF 
    15881488!--- 
    1589     tmp_opp = topp(pfileid,iv) 
    1590     ziv = var_zaxid(pfileid,iv) 
     1489    tmp_opp = W_F(idf)%W_V(iv)%topp 
     1490    ziv = W_F(idf)%W_V(iv)%z_axid 
    15911491!--- 
    15921492!   2.1 dimension of field 
     
    15981498        IF (ziv == -99) THEN 
    15991499          ndim = dim_cnt+1 
    1600           dims(dim_cnt+1:dim_cnt+2) = (/ tid(pfileid),0 /) 
     1500          dims(dim_cnt+1:dim_cnt+2) = (/ W_F(idf)%tid,0 /) 
    16011501        ELSE 
    16021502          ndim = dim_cnt+2 
    1603           dims(dim_cnt+1:dim_cnt+2) = (/zax_ids(pfileid,ziv),tid(pfileid)/) 
     1503          dims(dim_cnt+1:dim_cnt+2) = & 
     1504 &         (/ W_F(idf)%zax_ids(ziv),W_F(idf)%tid /) 
    16041505        ENDIF 
    16051506      ELSE 
     
    16091510        ELSE 
    16101511          ndim = dim_cnt+1 
    1611           dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(pfileid,ziv),0 /) 
     1512          dims(dim_cnt+1:dim_cnt+2) = (/ W_F(idf)%zax_ids(ziv),0 /) 
    16121513        ENDIF 
    16131514      ENDIF 
    16141515!- 
    1615       iret = NF90_DEF_VAR (ncid,TRIM(name(pfileid,iv)),NF90_FLOAT, & 
    1616  &                         dims(1:ABS(ndim)),ncvarid) 
    1617 !- 
    1618       ncvar_ids(pfileid,iv) = ncvarid 
    1619 !- 
    1620       IF (LEN_TRIM(unit_name(pfileid,iv)) > 0) THEN 
    1621         iret = NF90_PUT_ATT (ncid,ncvarid,'units', & 
    1622  &                           TRIM(unit_name(pfileid,iv))) 
     1516      iret = NF90_DEF_VAR (nfid,TRIM(W_F(idf)%W_V(iv)%v_name), & 
     1517 &             W_F(idf)%W_V(iv)%v_typ,dims(1:ABS(ndim)),nvid) 
     1518!- 
     1519      W_F(idf)%W_V(iv)%ncvid = nvid 
     1520!- 
     1521      IF (LEN_TRIM(W_F(idf)%W_V(iv)%unit_name) > 0) THEN 
     1522        iret = NF90_PUT_ATT (nfid,nvid,'units', & 
     1523 &                           TRIM(W_F(idf)%W_V(iv)%unit_name)) 
    16231524      ENDIF 
    1624       iret = NF90_PUT_ATT (ncid,ncvarid,'standard_name', & 
    1625  &                         TRIM(title(pfileid,iv))) 
    1626 !- 
    1627       iret = NF90_PUT_ATT (ncid,ncvarid,'_FillValue', & 
    1628  &                         REAL(missing_val,KIND=4)) 
    1629       IF (hist_wrt_rng(pfileid,iv)) THEN 
    1630         iret = NF90_PUT_ATT (ncid,ncvarid,'valid_min', & 
    1631  &                           REAL(hist_minmax(pfileid,iv,1),KIND=4)) 
    1632         iret = NF90_PUT_ATT (ncid,ncvarid,'valid_max', & 
    1633  &                           REAL(hist_minmax(pfileid,iv,2),KIND=4)) 
     1525      iret = NF90_PUT_ATT (nfid,nvid,'standard_name', & 
     1526 &                         TRIM(W_F(idf)%W_V(iv)%std_name)) 
     1527!- 
     1528      IF (W_F(idf)%W_V(iv)%v_typ == hist_r8) THEN 
     1529        iret = NF90_PUT_ATT (nfid,nvid,'_FillValue',NF90_FILL_REAL8) 
     1530      ELSE 
     1531        iret = NF90_PUT_ATT (nfid,nvid,'_FillValue',NF90_FILL_REAL4) 
    16341532      ENDIF 
    1635       iret = NF90_PUT_ATT (ncid,ncvarid,'long_name', & 
    1636  &                         TRIM(title(pfileid,iv))) 
    1637       iret = NF90_PUT_ATT (ncid,ncvarid,'online_operation', & 
    1638  &                         TRIM(fullop(pfileid,iv))) 
     1533      IF (W_F(idf)%W_V(iv)%hist_wrt_rng) THEN 
     1534        IF (W_F(idf)%W_V(iv)%v_typ == hist_r8) THEN 
     1535          iret = NF90_PUT_ATT (nfid,nvid,'valid_min', & 
     1536 &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(1),KIND=8)) 
     1537          iret = NF90_PUT_ATT (nfid,nvid,'valid_max', & 
     1538 &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(2),KIND=8)) 
     1539        ELSE 
     1540          iret = NF90_PUT_ATT (nfid,nvid,'valid_min', & 
     1541 &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(1),KIND=4)) 
     1542          iret = NF90_PUT_ATT (nfid,nvid,'valid_max', & 
     1543 &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(2),KIND=4)) 
     1544        ENDIF 
     1545      ENDIF 
     1546      iret = NF90_PUT_ATT (nfid,nvid,'long_name', & 
     1547 &                         TRIM(W_F(idf)%W_V(iv)%title)) 
     1548      iret = NF90_PUT_ATT (nfid,nvid,'online_operation', & 
     1549 &                         TRIM(W_F(idf)%W_V(iv)%fullop)) 
    16391550!- 
    16401551      SELECT CASE(ndim) 
     
    16461557      END SELECT 
    16471558!- 
    1648       assoc=TRIM(hax_name(pfileid,var_haxid(pfileid,iv),2)) & 
    1649  &   //' '//TRIM(hax_name(pfileid,var_haxid(pfileid,iv),1)) 
    1650 !- 
    1651       ziv = var_zaxid(pfileid,iv) 
     1559      assoc=TRIM(W_F(idf)%hax_name(W_F(idf)%W_V(iv)%h_axid,2)) & 
     1560 &   //' '//TRIM(W_F(idf)%hax_name(W_F(idf)%W_V(iv)%h_axid,1)) 
     1561!- 
     1562      ziv = W_F(idf)%W_V(iv)%z_axid 
    16521563      IF (ziv > 0) THEN 
    1653         str30 = zax_name(pfileid,ziv) 
     1564        str30 = W_F(idf)%zax_name(ziv) 
    16541565        assoc = TRIM(str30)//' '//TRIM(assoc) 
    16551566      ENDIF 
    16561567!- 
    16571568      IF (itax > 0) THEN 
    1658         IF (nb_tax(pfileid) > 1) THEN 
    1659           str30 = "t_"//tax_name(pfileid,itax) 
     1569        IF (itax > 1) THEN 
     1570          str30 = W_F(idf)%W_V(itax)%tax_name 
    16601571        ELSE 
    16611572          str30 = "time_counter" 
     
    16651576        IF (l_dbg) THEN 
    16661577          WRITE(*,*) "histend : 2.0.n, freq_opp, freq_wrt", & 
    1667  &                   freq_opp(pfileid,iv),freq_wrt(pfileid,iv) 
     1578 &          W_F(idf)%W_V(iv)%freq_opp,W_F(idf)%W_V(iv)%freq_wrt 
    16681579        ENDIF 
    16691580!- 
    1670         iret = NF90_PUT_ATT (ncid,ncvarid,'interval_operation', & 
    1671  &                           REAL(freq_opp(pfileid,iv),KIND=4)) 
    1672         iret = NF90_PUT_ATT (ncid,ncvarid,'interval_write', & 
    1673  &                           REAL(freq_wrt(pfileid,iv),KIND=4)) 
     1581        iret = NF90_PUT_ATT (nfid,nvid,'interval_operation', & 
     1582 &                           REAL(W_F(idf)%W_V(iv)%freq_opp,KIND=4)) 
     1583        iret = NF90_PUT_ATT (nfid,nvid,'interval_write', & 
     1584 &                           REAL(W_F(idf)%W_V(iv)%freq_wrt,KIND=4)) 
    16741585      ENDIF 
    1675       iret = NF90_PUT_ATT (ncid,ncvarid,'coordinates',TRIM(assoc)) 
     1586      iret = NF90_PUT_ATT (nfid,nvid,'coordinates',TRIM(assoc)) 
    16761587    ENDIF 
    16771588  ENDDO 
     
    16791590! 2.2 Add DOMAIN attributes if needed 
    16801591!- 
    1681   IF (dom_id_svg(pfileid) >= 0) THEN 
    1682     CALL flio_dom_att (ncid,dom_id_svg(pfileid)) 
     1592  IF (W_F(idf)%dom_id_svg >= 0) THEN 
     1593    CALL flio_dom_att (nfid,W_F(idf)%dom_id_svg) 
    16831594  ENDIF 
    16841595!- 
     
    16871598  IF (l_dbg) WRITE(*,*) "histend : 3.0" 
    16881599!- 
    1689   iret = NF90_ENDDEF (ncid) 
     1600  iret = NF90_ENDDEF (nfid) 
    16901601!- 
    16911602! 4.0 Give some informations to the user 
     
    16931604  IF (l_dbg) WRITE(*,*) "histend : 4.0" 
    16941605!- 
    1695   WRITE(str70,'("All variables have been initialized on file :",I3)') pfileid 
     1606  WRITE(str70,'("All variables have been initialized on file :",I3)') idf 
    16961607  CALL ipslerr (1,'histend',str70,'',' ') 
    16971608!--------------------- 
    16981609END SUBROUTINE histend 
    16991610!=== 
    1700 SUBROUTINE histwrite_r1d (pfileid,pvarname,pitau,pdata,nbindex,nindex) 
     1611SUBROUTINE histwrite_r1d (idf,pvarname,pitau,pdata,nbindex,nindex) 
    17011612!--------------------------------------------------------------------- 
    17021613  IMPLICIT NONE 
    17031614!- 
    1704   INTEGER,INTENT(IN) :: pfileid,pitau,nbindex 
     1615  INTEGER,INTENT(IN) :: idf,pitau,nbindex 
    17051616  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex 
    17061617  REAL,DIMENSION(:),INTENT(IN) :: pdata 
    17071618  CHARACTER(LEN=*),INTENT(IN) :: pvarname 
    17081619!--------------------------------------------------------------------- 
    1709   CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_1d=pdata) 
     1620  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_1d=pdata) 
    17101621!--------------------------- 
    17111622END SUBROUTINE histwrite_r1d 
    17121623!=== 
    1713 SUBROUTINE histwrite_r2d (pfileid,pvarname,pitau,pdata,nbindex,nindex) 
     1624SUBROUTINE histwrite_r2d (idf,pvarname,pitau,pdata,nbindex,nindex) 
    17141625!--------------------------------------------------------------------- 
    17151626  IMPLICIT NONE 
    17161627!- 
    1717   INTEGER,INTENT(IN) :: pfileid,pitau,nbindex 
     1628  INTEGER,INTENT(IN) :: idf,pitau,nbindex 
    17181629  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex 
    17191630  REAL,DIMENSION(:,:),INTENT(IN) :: pdata 
    17201631  CHARACTER(LEN=*),INTENT(IN) :: pvarname 
    17211632!--------------------------------------------------------------------- 
    1722   CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_2d=pdata) 
     1633  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_2d=pdata) 
    17231634!--------------------------- 
    17241635END SUBROUTINE histwrite_r2d 
    17251636!=== 
    1726 SUBROUTINE histwrite_r3d (pfileid,pvarname,pitau,pdata,nbindex,nindex) 
     1637SUBROUTINE histwrite_r3d (idf,pvarname,pitau,pdata,nbindex,nindex) 
    17271638!--------------------------------------------------------------------- 
    17281639  IMPLICIT NONE 
    17291640!- 
    1730   INTEGER,INTENT(IN) :: pfileid,pitau,nbindex 
     1641  INTEGER,INTENT(IN) :: idf,pitau,nbindex 
    17311642  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex 
    17321643  REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata 
    17331644  CHARACTER(LEN=*),INTENT(IN) :: pvarname 
    17341645!--------------------------------------------------------------------- 
    1735   CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_3d=pdata) 
     1646  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_3d=pdata) 
    17361647!--------------------------- 
    17371648END SUBROUTINE histwrite_r3d 
    17381649!=== 
    1739 SUBROUTINE histw_rnd (pfileid,pvarname,pitau,nbindex,nindex, & 
     1650SUBROUTINE histw_rnd (idf,pvarname,pitau,nbindex,nindex, & 
    17401651  &                   pdata_1d,pdata_2d,pdata_3d) 
    17411652!--------------------------------------------------------------------- 
    17421653  IMPLICIT NONE 
    17431654!- 
    1744   INTEGER,INTENT(IN) :: pfileid,pitau,nbindex 
     1655  INTEGER,INTENT(IN) :: idf,pitau,nbindex 
    17451656  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex 
    17461657  CHARACTER(LEN=*),INTENT(IN) :: pvarname 
     
    17501661!- 
    17511662  LOGICAL :: do_oper,do_write,largebuf,l1d,l2d,l3d 
    1752   INTEGER :: varid,io,nbpt_out 
     1663  INTEGER :: iv,io,nbpt_out 
    17531664  INTEGER              :: nbpt_in1 
    17541665  INTEGER,DIMENSION(2) :: nbpt_in2 
    17551666  INTEGER,DIMENSION(3) :: nbpt_in3 
    1756   REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp 
    1757   INTEGER,SAVE :: buff_tmp_sz 
     1667  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: tbf_1 
    17581668  CHARACTER(LEN=7) :: tmp_opp 
    17591669  CHARACTER(LEN=13) :: c_nam 
     
    17711681  ENDIF 
    17721682!- 
     1683  IF (l_dbg) THEN 
     1684    WRITE(*,*) "histwrite : ",c_nam 
     1685  ENDIF 
     1686!- 
    17731687! 1.0 Try to catch errors like specifying the wrong file ID. 
    17741688!     Thanks Marine for showing us what errors users can make ! 
    17751689!- 
    1776   IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN 
     1690  IF ( (idf < 1).OR.(idf > nb_files_max) ) THEN 
    17771691    CALL ipslerr (3,"histwrite", & 
    17781692 &    'Illegal file ID in the histwrite of variable',pvarname,' ') 
     
    17811695! 1.1 Find the id of the variable to be written and the real time 
    17821696!- 
    1783   CALL histvar_seq (pfileid,pvarname,varid) 
     1697  CALL histvar_seq (idf,pvarname,iv) 
    17841698!- 
    17851699! 2.0 do nothing for never operation 
    17861700!- 
    1787   tmp_opp = topp(pfileid,varid) 
     1701  tmp_opp = W_F(idf)%W_V(iv)%topp 
    17881702!- 
    17891703  IF (TRIM(tmp_opp) == "never") THEN 
    1790     last_opp_chk(pfileid,varid) = -99 
    1791     last_wrt_chk(pfileid,varid) = -99 
     1704    W_F(idf)%W_V(iv)%last_opp_chk = -99 
     1705    W_F(idf)%W_V(iv)%last_wrt_chk = -99 
    17921706  ENDIF 
    17931707!- 
    17941708! 3.0 We check if we need to do an operation 
    17951709!- 
    1796   IF (last_opp_chk(pfileid,varid) == pitau) THEN 
     1710  IF (W_F(idf)%W_V(iv)%last_opp_chk == pitau) THEN 
    17971711    CALL ipslerr (3,"histwrite", & 
    17981712 &    'This variable has already been analysed at the present', & 
     
    18011715!- 
    18021716  CALL isittime & 
    1803  &  (pitau,date0(pfileid),deltat(pfileid),freq_opp(pfileid,varid), & 
    1804  &   last_opp(pfileid,varid),last_opp_chk(pfileid,varid),do_oper) 
     1717 &  (pitau,W_F(idf)%date0,W_F(idf)%deltat, & 
     1718 &   W_F(idf)%W_V(iv)%freq_opp, & 
     1719 &   W_F(idf)%W_V(iv)%last_opp, & 
     1720 &   W_F(idf)%W_V(iv)%last_opp_chk,do_oper) 
    18051721!- 
    18061722! 4.0 We check if we need to write the data 
    18071723!- 
    1808   IF (last_wrt_chk(pfileid,varid) == pitau) THEN 
     1724  IF (W_F(idf)%W_V(iv)%last_wrt_chk == pitau) THEN 
    18091725    CALL ipslerr (3,"histwrite", & 
    1810  &    'This variable has already been written for the present', & 
    1811  &    'time step',TRIM(pvarname)) 
     1726 &    'This variable as already been written for the present', & 
     1727 &    'time step',' ') 
    18121728  ENDIF 
    18131729!- 
    18141730  CALL isittime & 
    1815  &  (pitau,date0(pfileid),deltat(pfileid),freq_wrt(pfileid,varid), & 
    1816  &   last_wrt(pfileid,varid),last_wrt_chk(pfileid,varid),do_write) 
     1731 &  (pitau,W_F(idf)%date0,W_F(idf)%deltat, & 
     1732 &   W_F(idf)%W_V(iv)%freq_wrt, & 
     1733 &   W_F(idf)%W_V(iv)%last_wrt, & 
     1734 &   W_F(idf)%W_V(iv)%last_wrt_chk,do_write) 
    18171735!- 
    18181736! 5.0 histwrite called 
     
    18221740!-- 5.1 Get the sizes of the data we will handle 
    18231741!- 
    1824     IF (datasz_in(pfileid,varid,1) <= 0) THEN 
     1742    IF (W_F(idf)%W_V(iv)%datasz_in(1) <= 0) THEN 
    18251743!---- There is the risk here that the user has over-sized the array. 
    18261744!---- But how can we catch this ? 
    18271745!---- In the worst case we will do impossible operations 
    18281746!---- on part of the data ! 
    1829       datasz_in(pfileid,varid,1:3) = -1 
     1747      W_F(idf)%W_V(iv)%datasz_in(1:3) = -1 
    18301748      IF      (l1d) THEN 
    1831         datasz_in(pfileid,varid,1) = SIZE(pdata_1d) 
     1749        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_1d) 
    18321750      ELSE IF (l2d) THEN 
    1833         datasz_in(pfileid,varid,1) = SIZE(pdata_2d,DIM=1) 
    1834         datasz_in(pfileid,varid,2) = SIZE(pdata_2d,DIM=2) 
     1751        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_2d,DIM=1) 
     1752        W_F(idf)%W_V(iv)%datasz_in(2) = SIZE(pdata_2d,DIM=2) 
    18351753      ELSE IF (l3d) THEN 
    1836         datasz_in(pfileid,varid,1) = SIZE(pdata_3d,DIM=1) 
    1837         datasz_in(pfileid,varid,2) = SIZE(pdata_3d,DIM=2) 
    1838         datasz_in(pfileid,varid,3) = SIZE(pdata_3d,DIM=3) 
     1754        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_3d,DIM=1) 
     1755        W_F(idf)%W_V(iv)%datasz_in(2) = SIZE(pdata_3d,DIM=2) 
     1756        W_F(idf)%W_V(iv)%datasz_in(3) = SIZE(pdata_3d,DIM=3) 
    18391757      ENDIF 
    18401758    ENDIF 
     
    18421760!-- 5.2 The maximum size of the data will give the size of the buffer 
    18431761!- 
    1844     IF (datasz_max(pfileid,varid) <= 0) THEN 
     1762    IF (W_F(idf)%W_V(iv)%datasz_max <= 0) THEN 
    18451763      largebuf = .FALSE. 
    1846       DO io=1,nbopp(pfileid,varid) 
    1847         IF (INDEX(fuchnbout,sopps(pfileid,varid,io)) > 0) THEN 
     1764      DO io=1,W_F(idf)%W_V(iv)%nbopp 
     1765        IF (INDEX(fuchnbout,W_F(idf)%W_V(iv)%sopp(io)) > 0) THEN 
    18481766          largebuf = .TRUE. 
    18491767        ENDIF 
    18501768      ENDDO 
    18511769      IF (largebuf) THEN 
    1852         datasz_max(pfileid,varid) = & 
    1853  &        scsize(pfileid,varid,1) & 
    1854  &       *scsize(pfileid,varid,2) & 
    1855  &       *scsize(pfileid,varid,3) 
     1770        W_F(idf)%W_V(iv)%datasz_max = & 
     1771 &        W_F(idf)%W_V(iv)%scsize(1) & 
     1772 &       *W_F(idf)%W_V(iv)%scsize(2) & 
     1773 &       *W_F(idf)%W_V(iv)%scsize(3) 
    18561774      ELSE 
    18571775        IF      (l1d) THEN 
    1858           datasz_max(pfileid,varid) = & 
    1859  &          datasz_in(pfileid,varid,1) 
     1776          W_F(idf)%W_V(iv)%datasz_max = & 
     1777 &          W_F(idf)%W_V(iv)%datasz_in(1) 
    18601778        ELSE IF (l2d) THEN 
    1861           datasz_max(pfileid,varid) = & 
    1862  &          datasz_in(pfileid,varid,1) & 
    1863  &         *datasz_in(pfileid,varid,2) 
     1779          W_F(idf)%W_V(iv)%datasz_max = & 
     1780 &          W_F(idf)%W_V(iv)%datasz_in(1) & 
     1781 &         *W_F(idf)%W_V(iv)%datasz_in(2) 
    18641782        ELSE IF (l3d) THEN 
    1865           datasz_max(pfileid,varid) = & 
    1866  &          datasz_in(pfileid,varid,1) & 
    1867  &         *datasz_in(pfileid,varid,2) & 
    1868  &         *datasz_in(pfileid,varid,3) 
     1783          W_F(idf)%W_V(iv)%datasz_max = & 
     1784 &          W_F(idf)%W_V(iv)%datasz_in(1) & 
     1785 &         *W_F(idf)%W_V(iv)%datasz_in(2) & 
     1786 &         *W_F(idf)%W_V(iv)%datasz_in(3) 
    18691787        ENDIF 
    18701788      ENDIF 
    18711789    ENDIF 
    18721790!- 
    1873     IF (.NOT.ALLOCATED(buff_tmp)) THEN 
     1791    IF (.NOT.ALLOCATED(tbf_1)) THEN 
    18741792      IF (l_dbg) THEN 
    18751793        WRITE(*,*) & 
    1876  &       c_nam//" : allocate buff_tmp for buff_sz = ", & 
    1877  &       datasz_max(pfileid,varid) 
     1794 &       c_nam//" : allocate tbf_1 for size = ", & 
     1795 &       W_F(idf)%W_V(iv)%datasz_max 
    18781796      ENDIF 
    1879       ALLOCATE(buff_tmp(datasz_max(pfileid,varid))) 
    1880       buff_tmp_sz = datasz_max(pfileid,varid) 
    1881     ELSE IF (datasz_max(pfileid,varid) > buff_tmp_sz) THEN 
     1797      ALLOCATE(tbf_1(W_F(idf)%W_V(iv)%datasz_max)) 
     1798    ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_1)) THEN 
    18821799      IF (l_dbg) THEN 
    18831800        WRITE(*,*) & 
    1884  &       c_nam//" : re-allocate buff_tmp for buff_sz = ", & 
    1885  &       datasz_max(pfileid,varid) 
     1801 &       c_nam//" : re-allocate tbf_1 for size = ", & 
     1802 &       W_F(idf)%W_V(iv)%datasz_max 
    18861803      ENDIF 
    1887       DEALLOCATE(buff_tmp) 
    1888       ALLOCATE(buff_tmp(datasz_max(pfileid,varid))) 
    1889       buff_tmp_sz = datasz_max(pfileid,varid) 
     1804      DEALLOCATE(tbf_1) 
     1805      ALLOCATE(tbf_1(W_F(idf)%W_V(iv)%datasz_max)) 
    18901806    ENDIF 
    18911807!- 
     
    18941810!-- of the data at the same time. This should speed up things. 
    18951811!- 
    1896     nbpt_out = datasz_max(pfileid,varid) 
     1812    nbpt_out = W_F(idf)%W_V(iv)%datasz_max 
    18971813    IF      (l1d) THEN 
    1898       nbpt_in1 = datasz_in(pfileid,varid,1) 
    1899       CALL mathop (sopps(pfileid,varid,1),nbpt_in1,pdata_1d, & 
     1814      nbpt_in1 = W_F(idf)%W_V(iv)%datasz_in(1) 
     1815      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in1,pdata_1d, & 
    19001816 &                 missing_val,nbindex,nindex, & 
    1901  &                 scal(pfileid,varid,1),nbpt_out,buff_tmp) 
     1817 &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1) 
    19021818    ELSE IF (l2d) THEN 
    1903       nbpt_in2(1:2) = datasz_in(pfileid,varid,1:2) 
    1904       CALL mathop (sopps(pfileid,varid,1),nbpt_in2,pdata_2d, & 
     1819      nbpt_in2(1:2) = W_F(idf)%W_V(iv)%datasz_in(1:2) 
     1820      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in2,pdata_2d, & 
    19051821 &                 missing_val,nbindex,nindex, & 
    1906  &                 scal(pfileid,varid,1),nbpt_out,buff_tmp) 
     1822 &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1) 
    19071823    ELSE IF (l3d) THEN 
    1908       nbpt_in3(1:3) = datasz_in(pfileid,varid,1:3) 
    1909       CALL mathop (sopps(pfileid,varid,1),nbpt_in3,pdata_3d, & 
     1824      nbpt_in3(1:3) = W_F(idf)%W_V(iv)%datasz_in(1:3) 
     1825      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in3,pdata_3d, & 
    19101826 &                 missing_val,nbindex,nindex, & 
    1911  &                 scal(pfileid,varid,1),nbpt_out,buff_tmp) 
    1912     ENDIF 
    1913     CALL histwrite_real (pfileid,varid,pitau,nbpt_out, & 
    1914  &            buff_tmp,nbindex,nindex,do_oper,do_write) 
     1827 &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1) 
     1828    ENDIF 
     1829    CALL histwrite_real (idf,iv,pitau,nbpt_out, & 
     1830 &            tbf_1,nbindex,nindex,do_oper,do_write) 
    19151831  ENDIF 
    19161832!- 
     
    19181834!- 
    19191835  IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN 
    1920     last_opp_chk(pfileid,varid) = pitau 
    1921     last_wrt_chk(pfileid,varid) = pitau 
     1836    W_F(idf)%W_V(iv)%last_opp_chk = pitau 
     1837    W_F(idf)%W_V(iv)%last_wrt_chk = pitau 
    19221838  ELSE 
    1923     last_opp_chk(pfileid,varid) = -99 
    1924     last_wrt_chk(pfileid,varid) = -99 
     1839    W_F(idf)%W_V(iv)%last_opp_chk = -99 
     1840    W_F(idf)%W_V(iv)%last_wrt_chk = -99 
    19251841  ENDIF 
    19261842!----------------------- 
     
    19281844!=== 
    19291845SUBROUTINE histwrite_real & 
    1930  & (pfileid,varid,pitau,nbdpt,buff_tmp,nbindex,nindex,do_oper,do_write) 
     1846 & (idf,iv,pitau,nbdpt,tbf_1,nbindex,nindex,do_oper,do_write) 
    19311847!--------------------------------------------------------------------- 
    19321848!- This subroutine is internal and does the calculations and writing 
     
    19361852  IMPLICIT NONE 
    19371853!- 
    1938   INTEGER,INTENT(IN) :: pfileid,pitau,varid, & 
     1854  INTEGER,INTENT(IN) :: idf,pitau,iv, & 
    19391855 &                      nbindex,nindex(nbindex),nbdpt 
    1940   REAL,DIMENSION(:)  :: buff_tmp 
     1856  REAL,DIMENSION(:)  :: tbf_1 
    19411857  LOGICAL,INTENT(IN) :: do_oper,do_write 
    19421858!- 
    1943   INTEGER :: tsz,ncid,ncvarid,i,iret,ipt,itax,io,nbin,nbout 
     1859  INTEGER :: tsz,nfid,nvid,iret,itax,io,nbin,nbout 
    19441860  INTEGER :: nx,ny,nz,ky,kz,kt,kc 
    19451861  INTEGER,DIMENSION(4) :: corner,edges 
     
    19471863!- 
    19481864  REAL :: rtime 
     1865  REAL,DIMENSION(2) :: t_bnd 
    19491866  CHARACTER(LEN=7) :: tmp_opp 
    1950   REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp2,buffer_used 
    1951   INTEGER,SAVE :: buff_tmp2_sz,buffer_sz 
     1867  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: tbf_2 
    19521868  LOGICAL :: l_dbg 
    19531869!--------------------------------------------------------------------- 
     
    19551871!- 
    19561872  IF (l_dbg) THEN 
    1957     WRITE(*,*) "histwrite 0.0 : VAR : ",name(pfileid,varid) 
    1958     WRITE(*,*) "histwrite 0.0 : nbindex,nindex :", & 
    1959  &  nbindex,nindex(1:MIN(3,nbindex)),'...',nindex(MAX(1,nbindex-3):nbindex) 
     1873    WRITE(*,*) "histwrite 0.0 : VAR : ",W_F(idf)%W_V(iv)%v_name 
     1874    WRITE(*,*) "histwrite 0.0 : nbindex :",nbindex 
     1875    WRITE(*,*) "histwrite 0.0 : nindex  :",nindex(1:MIN(3,nbindex)),'...' 
    19601876  ENDIF 
    19611877!- 
    19621878! The sizes which can be encoutered 
    19631879!- 
    1964   tsz =  zsize(pfileid,varid,1) & 
    1965  &      *zsize(pfileid,varid,2) & 
    1966  &      *zsize(pfileid,varid,3) 
    1967 !- 
    1968 ! 1.0 We allocate the memory needed to store the data between write 
    1969 !     and the temporary space needed for operations. 
    1970 !     We have to keep precedent buffer if needed 
    1971 !- 
    1972   IF (.NOT. ALLOCATED(buffer)) THEN 
    1973     IF (l_dbg) WRITE(*,*) "histwrite_real 1.0 allocate buffer ",buff_pos 
    1974     ALLOCATE(buffer(buff_pos)) 
    1975     buffer_sz = buff_pos 
    1976     buffer(:)=0.0 
    1977   ELSE IF (buffer_sz < buff_pos) THEN 
     1880  tsz =  W_F(idf)%W_V(iv)%zsize(1) & 
     1881 &      *W_F(idf)%W_V(iv)%zsize(2) & 
     1882 &      *W_F(idf)%W_V(iv)%zsize(3) 
     1883!- 
     1884! 1.0 We allocate and the temporary space needed for operations. 
     1885!     The buffers are only deallocated when more space is needed. 
     1886!     This reduces the umber of allocates but increases memory needs. 
     1887!- 
     1888  IF (.NOT.ALLOCATED(tbf_2)) THEN 
    19781889    IF (l_dbg) THEN 
    1979       WRITE(*,*) "histwrite_real 1.0.1 re-allocate buffer for ", & 
    1980  &      buff_pos," instead of ",SIZE(buffer) 
    1981     ENDIF 
    1982     IF (SUM(buffer)/=0.0) THEN 
    1983       IF (l_dbg) WRITE (*,*) 'histwrite : buffer has been used. ', & 
    1984  &      'We have to save it before re-allocating.' 
    1985       ALLOCATE(buffer_used(buffer_sz)) 
    1986       buffer_used(:)=buffer(:) 
    1987       DEALLOCATE(buffer) 
    1988       ALLOCATE(buffer(buff_pos)) 
    1989       buffer_sz = buff_pos 
    1990       buffer(:)=0.0 
    1991       buffer(:SIZE(buffer_used))=buffer_used 
    1992       DEALLOCATE(buffer_used) 
    1993     ELSE 
    1994       IF (l_dbg) WRITE (*,*) 'histwrite : buffer has not been used. ', & 
    1995  &      'We have just to re-allocate it.' 
    1996       DEALLOCATE(buffer) 
    1997       ALLOCATE(buffer(buff_pos)) 
    1998       buffer_sz = buff_pos 
    1999       buffer(:)=0.0 
    2000     ENDIF 
    2001   ENDIF 
    2002 !- 
    2003 ! The buffers are only deallocated when more space is needed. This 
    2004 ! reduces the umber of allocates but increases memory needs. 
    2005 !- 
    2006   IF (.NOT.ALLOCATED(buff_tmp2)) THEN 
     1890      WRITE(*,*) "histwrite_real 1.1 allocate tbf_2 ",SIZE(tbf_1) 
     1891    ENDIF 
     1892    ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max)) 
     1893  ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_2)) THEN 
    20071894    IF (l_dbg) THEN 
    2008       WRITE(*,*) "histwrite_real 1.1 allocate buff_tmp2 ",SIZE(buff_tmp) 
    2009     ENDIF 
    2010     ALLOCATE(buff_tmp2(datasz_max(pfileid,varid))) 
    2011     buff_tmp2_sz = datasz_max(pfileid,varid) 
    2012   ELSE IF (datasz_max(pfileid,varid) > buff_tmp2_sz) THEN 
    2013     IF (l_dbg) THEN 
    2014       WRITE(*,*) "histwrite_real 1.2 re-allocate buff_tmp2 : ", & 
    2015      & SIZE(buff_tmp)," instead of ",SIZE(buff_tmp2) 
    2016     ENDIF 
    2017     DEALLOCATE(buff_tmp2) 
    2018     ALLOCATE(buff_tmp2(datasz_max(pfileid,varid))) 
    2019     buff_tmp2_sz = datasz_max(pfileid,varid) 
    2020   ENDIF 
    2021 !- 
    2022   rtime = pitau * deltat(pfileid) 
    2023   tmp_opp = topp(pfileid,varid) 
    2024 !- 
    2025 ! 3.0 Do the operations or transfer the slab of data into buff_tmp 
    2026 !- 
    2027   IF (l_dbg) WRITE(*,*) "histwrite: 3.0",pfileid 
     1895      WRITE(*,*) "histwrite_real 1.2 re-allocate tbf_2 : ", & 
     1896     & SIZE(tbf_1)," instead of ",SIZE(tbf_2) 
     1897    ENDIF 
     1898    DEALLOCATE(tbf_2) 
     1899    ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max)) 
     1900  ENDIF 
     1901!- 
     1902  rtime = pitau*W_F(idf)%deltat 
     1903  tmp_opp = W_F(idf)%W_V(iv)%topp 
     1904!- 
     1905! 3.0 Do the operations or transfer the slab of data into tbf_1 
     1906!- 
     1907  IF (l_dbg) THEN 
     1908    WRITE(*,*) "histwrite: 3.0",idf 
     1909  ENDIF 
    20281910!- 
    20291911! 3.1 DO the Operations only if needed 
    20301912!- 
    20311913  IF (do_oper) THEN 
    2032     i = pfileid 
    20331914    nbout = nbdpt 
    20341915!- 
     
    20361917!--     we started in the interface routine 
    20371918!- 
    2038     DO io = 2,nbopp(i,varid),2 
     1919    DO io=2,W_F(idf)%W_V(iv)%nbopp,2 
    20391920      nbin = nbout 
    2040       nbout = datasz_max(i,varid) 
    2041       CALL mathop(sopps(i,varid,io),nbin,buff_tmp,missing_val, & 
    2042  &      nbindex,nindex,scal(i,varid,io),nbout,buff_tmp2) 
     1921      nbout = W_F(idf)%W_V(iv)%datasz_max 
     1922      CALL mathop(W_F(idf)%W_V(iv)%sopp(io),nbin,tbf_1, & 
     1923 &      missing_val,nbindex,nindex,W_F(idf)%W_V(iv)%scal(io), & 
     1924 &      nbout,tbf_2) 
    20431925      IF (l_dbg) THEN 
    20441926        WRITE(*,*) & 
    2045  &       "histwrite: 3.4a nbout : ",nbin,nbout,sopps(i,varid,io) 
     1927 &       "histwrite: 3.4a nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io) 
    20461928      ENDIF 
    20471929!- 
    20481930      nbin = nbout 
    2049       nbout = datasz_max(i,varid) 
    2050       CALL mathop(sopps(i,varid,io+1),nbin,buff_tmp2,missing_val, & 
    2051  &      nbindex,nindex,scal(i,varid,io+1),nbout,buff_tmp) 
     1931      nbout = W_F(idf)%W_V(iv)%datasz_max 
     1932      CALL mathop(W_F(idf)%W_V(iv)%sopp(io+1),nbin,tbf_2, & 
     1933 &      missing_val,nbindex,nindex,W_F(idf)%W_V(iv)%scal(io+1), & 
     1934 &      nbout,tbf_1) 
    20521935      IF (l_dbg) THEN 
    20531936        WRITE(*,*) & 
    2054  &       "histwrite: 3.4b nbout : ",nbin,nbout,sopps(i,varid,io+1) 
     1937 &     "histwrite: 3.4b nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io+1) 
    20551938      ENDIF 
    20561939    ENDDO 
     
    20601943    IF (l_dbg) THEN 
    20611944      WRITE(*,*) & 
    2062  &     "histwrite: 3.5 size(buff_tmp) : ",SIZE(buff_tmp) 
     1945 &     "histwrite: 3.5 size(tbf_1) : ",SIZE(tbf_1) 
    20631946      WRITE(*,*) & 
    2064  &     "histwrite: 3.5 slab in X :",zorig(i,varid,1),zsize(i,varid,1) 
     1947 &     "histwrite: 3.5 slab in X :", & 
     1948 &     W_F(idf)%W_V(iv)%zorig(1),W_F(idf)%W_V(iv)%zsize(1) 
    20651949      WRITE(*,*) & 
    2066  &     "histwrite: 3.5 slab in Y :",zorig(i,varid,2),zsize(i,varid,2) 
     1950 &     "histwrite: 3.5 slab in Y :", & 
     1951 &     W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zsize(2) 
    20671952      WRITE(*,*) & 
    2068  &     "histwrite: 3.5 slab in Z :",zorig(i,varid,3),zsize(i,varid,3) 
     1953 &     "histwrite: 3.5 slab in Z :", & 
     1954 &     W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zsize(3) 
    20691955      WRITE(*,*) & 
    20701956 &     "histwrite: 3.5 slab of input:", & 
    2071  &     scsize(i,varid,1),scsize(i,varid,2),scsize(i,varid,3) 
     1957 &     W_F(idf)%W_V(iv)%scsize(1), & 
     1958 &     W_F(idf)%W_V(iv)%scsize(2), & 
     1959 &     W_F(idf)%W_V(iv)%scsize(3) 
    20721960    ENDIF 
    20731961!--- 
    20741962!-- We have to consider blocks of contiguous data 
    20751963!--- 
    2076     nx=MAX(zsize(i,varid,1),1) 
    2077     ny=MAX(zsize(i,varid,2),1) 
    2078     nz=MAX(zsize(i,varid,3),1) 
    2079     IF     (     (zorig(i,varid,1) == 1) & 
    2080    &        .AND.(zsize(i,varid,1) == scsize(i,varid,1)) & 
    2081    &        .AND.(zorig(i,varid,2) == 1) & 
    2082    &        .AND.(zsize(i,varid,2) == scsize(i,varid,2))) THEN 
    2083       kt = (zorig(i,varid,3)-1)*nx*ny 
    2084       buff_tmp2(1:nx*ny*nz) = buff_tmp(kt+1:kt+nx*ny*nz) 
    2085     ELSEIF (     (zorig(i,varid,1) == 1) & 
    2086    &        .AND.(zsize(i,varid,1) == scsize(i,varid,1))) THEN 
     1964    nx=MAX(W_F(idf)%W_V(iv)%zsize(1),1) 
     1965    ny=MAX(W_F(idf)%W_V(iv)%zsize(2),1) 
     1966    nz=MAX(W_F(idf)%W_V(iv)%zsize(3),1) 
     1967    IF     (     (W_F(idf)%W_V(iv)%zorig(1) == 1) & 
     1968 &          .AND.(   W_F(idf)%W_V(iv)%zsize(1) & 
     1969 &                == W_F(idf)%W_V(iv)%scsize(1)) & 
     1970 &          .AND.(W_F(idf)%W_V(iv)%zorig(2) == 1) & 
     1971 &          .AND.(   W_F(idf)%W_V(iv)%zsize(2) & 
     1972 &                == W_F(idf)%W_V(iv)%scsize(2))) THEN 
     1973      kt = (W_F(idf)%W_V(iv)%zorig(3)-1)*nx*ny 
     1974      tbf_2(1:nx*ny*nz) = tbf_1(kt+1:kt+nx*ny*nz) 
     1975    ELSEIF (     (W_F(idf)%W_V(iv)%zorig(1) == 1) & 
     1976 &          .AND.(   W_F(idf)%W_V(iv)%zsize(1) & 
     1977 &                == W_F(idf)%W_V(iv)%scsize(1))) THEN 
    20871978      kc = -nx*ny 
    2088       DO kz=zorig(i,varid,3),zorig(i,varid,3)+nz-1 
     1979      DO kz=W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zorig(3)+nz-1 
    20891980        kc = kc+nx*ny 
    2090         kt = ((kz-1)*scsize(i,varid,2)+zorig(i,varid,2)-1)*nx 
    2091         buff_tmp2(kc+1:kc+nx*ny) = buff_tmp(kt+1:kt+nx*ny) 
     1981        kt = ( (kz-1)*W_F(idf)%W_V(iv)%scsize(2) & 
     1982 &            +W_F(idf)%W_V(iv)%zorig(2)-1)*nx 
     1983        tbf_2(kc+1:kc+nx*ny) = tbf_1(kt+1:kt+nx*ny) 
    20921984      ENDDO 
    20931985    ELSE 
    20941986      kc = -nx 
    2095       DO kz=zorig(i,varid,3),zorig(i,varid,3)+nz-1 
    2096         DO ky=zorig(i,varid,2),zorig(i,varid,2)+ny-1 
     1987      DO kz=W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zorig(3)+nz-1 
     1988        DO ky=W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zorig(2)+ny-1 
    20971989          kc = kc+nx 
    2098           kt = ((kz-1)*scsize(i,varid,2)+ky-1)*scsize(i,varid,1) & 
    2099    &          +zorig(i,varid,1)-1 
    2100           buff_tmp2(kc+1:kc+nx) = buff_tmp(kt+1:kt+nx) 
     1990          kt = ((kz-1)*W_F(idf)%W_V(iv)%scsize(2)+ky-1) & 
     1991 &            *W_F(idf)%W_V(iv)%scsize(1) & 
     1992 &            +W_F(idf)%W_V(iv)%zorig(1)-1 
     1993          tbf_2(kc+1:kc+nx) = tbf_1(kt+1:kt+nx) 
    21011994        ENDDO 
    21021995      ENDDO 
    21031996    ENDIF 
    21041997!- 
    2105 !-- 4.0 Get the min and max of the field (buff_tmp) 
    2106 !- 
    2107     IF (l_dbg) WRITE(*,*) "histwrite: 4.0 buff_tmp",pfileid,varid, & 
    2108  &    TRIM(tmp_opp),' ---- ',LEN_TRIM(tmp_opp),nbindex 
    2109 !- 
    2110     IF (hist_calc_rng(pfileid,varid)) THEN 
    2111       hist_minmax(pfileid,varid,1) = & 
    2112  &      MIN(hist_minmax(pfileid,varid,1), & 
    2113  &      MINVAL(buff_tmp2(1:tsz),MASK=buff_tmp2(1:tsz) /= missing_val)) 
    2114       hist_minmax(pfileid,varid,2) = & 
    2115  &      MAX(hist_minmax(pfileid,varid,2), & 
    2116  &      MAXVAL(buff_tmp2(1:tsz),MASK=buff_tmp2(1:tsz) /= missing_val)) 
     1998!-- 4.0 Get the min and max of the field 
     1999!- 
     2000    IF (l_dbg) THEN 
     2001      WRITE(*,*) "histwrite: 4.0 tbf_1",idf,iv, & 
     2002 &      TRIM(tmp_opp),' ---- ',LEN_TRIM(tmp_opp),nbindex 
     2003    ENDIF 
     2004!- 
     2005    IF (W_F(idf)%W_V(iv)%hist_calc_rng) THEN 
     2006      W_F(idf)%W_V(iv)%hist_minmax(1) = & 
     2007 &      MIN(W_F(idf)%W_V(iv)%hist_minmax(1), & 
     2008 &      MINVAL(tbf_2(1:tsz),MASK=tbf_2(1:tsz) /= missing_val)) 
     2009      W_F(idf)%W_V(iv)%hist_minmax(2) = & 
     2010 &      MAX(W_F(idf)%W_V(iv)%hist_minmax(2), & 
     2011 &      MAXVAL(tbf_2(1:tsz),MASK=tbf_2(1:tsz) /= missing_val)) 
    21172012    ENDIF 
    21182013!- 
    21192014!-- 5.0 Do the operations if needed. In the case of instantaneous 
    2120 !--     output we do not transfer to the buffer. 
    2121 !- 
    2122     IF (l_dbg) WRITE(*,*) "histwrite: 5.0",pfileid,"tsz :",tsz 
    2123 !- 
    2124     ipt = point(pfileid,varid) 
    2125 !- 
    2126 !   WRITE(*,*) 'OPE ipt, buffer :',pvarname,ipt,varid 
     2015!--     output we do not transfer to the time_buffer. 
     2016!- 
     2017    IF (l_dbg) THEN 
     2018      WRITE(*,*) "histwrite: 5.0 idf : ",idf," iv : ",iv," tsz : ",tsz 
     2019    ENDIF 
    21272020!- 
    21282021    IF (     (TRIM(tmp_opp) /= "inst") & 
    2129    &    .AND.(TRIM(tmp_opp) /= "once") ) THEN 
    2130       CALL moycum(tmp_opp,tsz,buffer(ipt:), & 
    2131      &       buff_tmp2,nb_opp(pfileid,varid)) 
    2132     ENDIF 
    2133 !- 
    2134     last_opp(pfileid,varid) = pitau 
    2135     nb_opp(pfileid,varid) = nb_opp(pfileid,varid)+1 
     2022     .AND.(TRIM(tmp_opp) /= "once") ) THEN 
     2023      CALL moycum(tmp_opp,tsz,W_F(idf)%W_V(iv)%t_bf, & 
     2024 &           tbf_2,W_F(idf)%W_V(iv)%nb_opp) 
     2025    ENDIF 
     2026!- 
     2027    W_F(idf)%W_V(iv)%last_opp = pitau 
     2028    W_F(idf)%W_V(iv)%nb_opp = W_F(idf)%W_V(iv)%nb_opp+1 
    21362029!- 
    21372030  ENDIF 
     
    21392032! 6.0 Write to file if needed 
    21402033!- 
    2141   IF (l_dbg) WRITE(*,*) "histwrite: 6.0",pfileid 
     2034  IF (l_dbg) WRITE(*,*) "histwrite: 6.0",idf 
    21422035!- 
    21432036  IF (do_write) THEN 
    21442037!- 
    2145     ncvarid = ncvar_ids(pfileid,varid) 
    2146     ncid = ncdf_ids(pfileid) 
     2038    nfid = W_F(idf)%ncfid 
     2039    nvid = W_F(idf)%W_V(iv)%ncvid 
    21472040!- 
    21482041!-- 6.1 Do the operations that are needed before writting 
    21492042!- 
    2150     IF (l_dbg) WRITE(*,*) "histwrite: 6.1",pfileid 
     2043    IF (l_dbg) WRITE(*,*) "histwrite: 6.1",idf 
    21512044!- 
    21522045    IF (     (TRIM(tmp_opp) /= "inst") & 
    2153    &    .AND.(TRIM(tmp_opp) /= "once") ) THEN 
    2154       rtime = (rtime+last_wrt(pfileid,varid)*deltat(pfileid))/2.0 
     2046 &      .AND.(TRIM(tmp_opp) /= "once") ) THEN 
     2047      t_bnd(1:2) = (/ W_F(idf)%W_V(iv)%last_wrt*W_F(idf)%deltat,rtime /) 
     2048      rtime = (t_bnd(1)+t_bnd(2))/2.0 
    21552049    ENDIF 
    21562050!- 
     
    21582052!- 
    21592053    IF (     (TRIM(tmp_opp) /= "l_max") & 
    2160    &    .AND.(TRIM(tmp_opp) /= "l_min") & 
    2161    &    .AND.(TRIM(tmp_opp) /= "once") ) THEN 
    2162 !- 
    2163       IF (l_dbg) WRITE(*,*) "histwrite: 6.2",pfileid 
    2164 !- 
    2165       itax = var_axid(pfileid,varid) 
    2166       itime = nb_wrt(pfileid,varid)+1 
    2167 !- 
    2168       IF (tax_last(pfileid,itax) < itime) THEN 
    2169         iret = NF90_PUT_VAR (ncid,tdimid(pfileid,itax),(/ rtime /), & 
    2170  &                            start=(/ itime /),count=(/ 1 /)) 
    2171         tax_last(pfileid,itax) = itime 
     2054 &      .AND.(TRIM(tmp_opp) /= "l_min") & 
     2055 &      .AND.(TRIM(tmp_opp) /= "once") ) THEN 
     2056!- 
     2057      IF (l_dbg) WRITE(*,*) "histwrite: 6.2",idf 
     2058!- 
     2059      itax  = W_F(idf)%W_V(iv)%t_axid 
     2060      itime = W_F(idf)%W_V(iv)%nb_wrt+1 
     2061!- 
     2062      IF (W_F(idf)%W_V(itax)%tax_last < itime) THEN 
     2063        iret = NF90_PUT_VAR (nfid,W_F(idf)%W_V(itax)%tdimid, & 
     2064 &               (/ rtime /),start=(/ itime /),count=(/ 1 /)) 
     2065        IF (W_F(idf)%W_V(itax)%tbndid > 0) THEN 
     2066          iret = NF90_PUT_VAR (nfid,W_F(idf)%W_V(itax)%tbndid, & 
     2067 &                 t_bnd,start=(/ 1,itime /),count=(/ 2,1 /)) 
     2068        ENDIF 
     2069        W_F(idf)%W_V(itax)%tax_last = itime 
    21722070      ENDIF 
    21732071    ELSE 
     
    21792077!- 
    21802078    IF (l_dbg) THEN 
    2181       WRITE(*,*) "histwrite: 6.3",pfileid,ncid,ncvarid,varid,itime 
    2182     ENDIF 
    2183 !- 
    2184     IF (scsize(pfileid,varid,3) == 1) THEN 
    2185       IF (regular(pfileid)) THEN 
     2079      WRITE(*,*) "histwrite: 6.3",idf,nfid,nvid,iv,itime 
     2080    ENDIF 
     2081!- 
     2082    IF (W_F(idf)%W_V(iv)%scsize(3) == 1) THEN 
     2083      IF (W_F(idf)%regular) THEN 
    21862084        corner(1:4) = (/ 1,1,itime,0 /) 
    2187         edges(1:4) = (/ zsize(pfileid,varid,1), & 
    2188  &                      zsize(pfileid,varid,2),1,0 /) 
     2085        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), & 
     2086 &                      W_F(idf)%W_V(iv)%zsize(2),1,0 /) 
    21892087      ELSE 
    21902088        corner(1:4) = (/ 1,itime,0,0 /) 
    2191         edges(1:4) = (/ zsize(pfileid,varid,1),1,0,0 /) 
     2089        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1),1,0,0 /) 
    21922090      ENDIF 
    21932091    ELSE 
    2194       IF (regular(pfileid)) THEN 
     2092      IF (W_F(idf)%regular) THEN 
    21952093        corner(1:4) = (/ 1,1,1,itime /) 
    2196         edges(1:4) = (/ zsize(pfileid,varid,1), & 
    2197  &                      zsize(pfileid,varid,2), & 
    2198  &                      zsize(pfileid,varid,3),1 /) 
     2094        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), & 
     2095 &                      W_F(idf)%W_V(iv)%zsize(2), & 
     2096 &                      W_F(idf)%W_V(iv)%zsize(3),1 /) 
    21992097      ELSE 
    22002098        corner(1:4) = (/ 1,1,itime,0 /) 
    2201         edges(1:4) = (/ zsize(pfileid,varid,1), & 
    2202  &                      zsize(pfileid,varid,3),1,0 /) 
     2099        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), & 
     2100 &                      W_F(idf)%W_V(iv)%zsize(3),1,0 /) 
    22032101      ENDIF 
    22042102    ENDIF 
    2205 !- 
    2206     ipt = point(pfileid,varid) 
    22072103!- 
    22082104    IF (     (TRIM(tmp_opp) /= "inst") & 
    22092105 &      .AND.(TRIM(tmp_opp) /= "once") ) THEN 
    2210       iret = NF90_PUT_VAR (ncid,ncvarid,buffer(ipt:), & 
    2211  &                       start=corner(1:4),count=edges(1:4)) 
     2106      iret = NF90_PUT_VAR (nfid,nvid,W_F(idf)%W_V(iv)%t_bf, & 
     2107 &                         start=corner(1:4),count=edges(1:4)) 
    22122108    ELSE 
    2213       iret = NF90_PUT_VAR (ncid,ncvarid,buff_tmp2, & 
    2214  &                       start=corner(1:4),count=edges(1:4)) 
    2215     ENDIF 
    2216 !- 
    2217     last_wrt(pfileid,varid) = pitau 
    2218     nb_wrt(pfileid,varid) = nb_wrt(pfileid,varid)+1 
    2219     nb_opp(pfileid,varid) = 0 
     2109      iret = NF90_PUT_VAR (nfid,nvid,tbf_2, & 
     2110 &                         start=corner(1:4),count=edges(1:4)) 
     2111    ENDIF 
     2112!- 
     2113    W_F(idf)%W_V(iv)%last_wrt = pitau 
     2114    W_F(idf)%W_V(iv)%nb_wrt = W_F(idf)%W_V(iv)%nb_wrt+1 
     2115    W_F(idf)%W_V(iv)%nb_opp = 0 
    22202116!--- 
    22212117!   After the write the file can be synchronized so that no data is 
     
    22242120!   needed here to switch to this mode. 
    22252121!--- 
    2226 !   iret = NF90_SYNC (ncid) 
     2122!   iret = NF90_SYNC (nfid) 
    22272123!- 
    22282124  ENDIF 
     
    22302126END SUBROUTINE histwrite_real 
    22312127!=== 
    2232 SUBROUTINE histvar_seq (pfid,pvarname,pvid) 
    2233 !--------------------------------------------------------------------- 
    2234 !- This subroutine optimized the search for the variable in the table. 
     2128SUBROUTINE histvar_seq (idf,pvarname,idv) 
     2129!--------------------------------------------------------------------- 
     2130!- This subroutine optimize the search for the variable in the table. 
    22352131!- In a first phase it will learn the succession of the variables 
    22362132!- called and then it will use the table to guess what comes next. 
     
    22402136!- ARGUMENTS : 
    22412137!- 
    2242 !- pfid  : id of the file on which we work 
     2138!- idf      : id of the file on which we work 
    22432139!- pvarname : The name of the variable we are looking for 
    2244 !- pvid     : The var id we found 
     2140!- idv      : The var id we found 
    22452141!--------------------------------------------------------------------- 
    22462142  IMPLICIT NONE 
    22472143!- 
    2248   INTEGER,INTENT(in)  :: pfid 
     2144  INTEGER,INTENT(in)  :: idf 
    22492145  CHARACTER(LEN=*),INTENT(IN) :: pvarname 
    2250   INTEGER,INTENT(out) :: pvid 
     2146  INTEGER,INTENT(out) :: idv 
    22512147!- 
    22522148  LOGICAL,SAVE :: learning(nb_files_max)=.TRUE. 
     
    22632159!- 
    22642160  IF (l_dbg) THEN 
    2265     WRITE(*,*) 'histvar_seq, start of the subroutine :',learning(pfid) 
    2266   ENDIF 
    2267 !- 
    2268   IF (learning(pfid)) THEN 
     2161    WRITE(*,*) 'histvar_seq, start of the subroutine :',learning(idf) 
     2162  ENDIF 
     2163!- 
     2164  IF (learning(idf)) THEN 
    22692165!- 
    22702166!-- 1.0 We compute the length over which we are going 
    22712167!--     to check the overlap 
    22722168!- 
    2273     IF (overlap(pfid) <= 0) THEN 
    2274       IF (nb_var(pfid) > 6) THEN 
    2275         overlap(pfid) = nb_var(pfid)/3*2 
     2169    IF (overlap(idf) <= 0) THEN 
     2170      IF (W_F(idf)%n_var > 6) THEN 
     2171        overlap(idf) = W_F(idf)%n_var/3*2 
    22762172      ELSE 
    2277         overlap(pfid) = nb_var(pfid) 
     2173        overlap(idf) = W_F(idf)%n_var 
    22782174      ENDIF 
    22792175    ENDIF 
     
    22812177!-- 1.1 Find the position of this string 
    22822178!- 
    2283     CALL find_str (name(pfid,1:nb_var(pfid)),pvarname,pos) 
     2179    CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_var)%v_name,pvarname,pos) 
    22842180    IF (pos > 0) THEN 
    2285       pvid = pos 
     2181      idv = pos 
    22862182    ELSE 
    22872183      CALL ipslerr (3,"histvar_seq", & 
     
    22942190!--     in the sequence of calls 
    22952191!- 
    2296     IF (varseq_err(pfid) >= 0) THEN 
    2297       sp = varseq_len(pfid)+1 
     2192    IF (varseq_err(idf) >= 0) THEN 
     2193      sp = varseq_len(idf)+1 
    22982194      IF (sp <= nb_var_max*3) THEN 
    2299         varseq(pfid,sp) = pvid 
    2300         varseq_len(pfid) = sp 
     2195        varseq(idf,sp) = idv 
     2196        varseq_len(idf) = sp 
    23012197      ELSE 
    23022198        CALL ipslerr (2,"histvar_seq",& 
     
    23082204 &       ' contact the IOIPSL team. ') 
    23092205        WRITE(*,*) 'The sequence we have found up to now :' 
    2310         WRITE(*,*) varseq(pfid,1:sp-1) 
    2311         varseq_err(pfid) = -1 
     2206        WRITE(*,*) varseq(idf,1:sp-1) 
     2207        varseq_err(idf) = -1 
    23122208      ENDIF 
    23132209!- 
    23142210!---- 1.3 Check if we have found the right overlap 
    23152211!- 
    2316       IF (varseq_len(pfid) .GE. overlap(pfid)*2) THEN 
     2212      IF (varseq_len(idf) >= overlap(idf)*2) THEN 
    23172213!- 
    23182214!------ We skip a few variables if needed as they could come 
    23192215!------ from the initialisation of the model. 
    23202216!- 
    2321         DO ib = 0,sp-overlap(pfid)*2 
    2322           IF ( learning(pfid) .AND.& 
    2323             & SUM(ABS(varseq(pfid,ib+1:ib+overlap(pfid)) -& 
    2324             & varseq(pfid,sp-overlap(pfid)+1:sp))) == 0 ) THEN 
    2325             learning(pfid) = .FALSE. 
    2326             varseq_len(pfid) = sp-overlap(pfid)-ib 
    2327             varseq_pos(pfid) = overlap(pfid)+ib 
    2328             varseq(pfid,1:varseq_len(pfid)) = & 
    2329  &            varseq(pfid,ib+1:ib+varseq_len(pfid)) 
     2217        DO ib = 0,sp-overlap(idf)*2 
     2218          IF ( learning(idf) .AND.& 
     2219            & SUM(ABS(varseq(idf,ib+1:ib+overlap(idf)) -& 
     2220            & varseq(idf,sp-overlap(idf)+1:sp))) == 0 ) THEN 
     2221            learning(idf) = .FALSE. 
     2222            varseq_len(idf) = sp-overlap(idf)-ib 
     2223            varseq_pos(idf) = overlap(idf)+ib 
     2224            varseq(idf,1:varseq_len(idf)) = & 
     2225 &            varseq(idf,ib+1:ib+varseq_len(idf)) 
    23302226          ENDIF 
    23312227        ENDDO 
     
    23372233!--     and we can get a guess at the var ID 
    23382234!- 
    2339     nn = varseq_pos(pfid)+1 
    2340     IF (nn > varseq_len(pfid)) nn = 1 
    2341 !- 
    2342     pvid = varseq(pfid,nn) 
    2343 !- 
    2344     IF (TRIM(name(pfid,pvid)) /= TRIM(pvarname)) THEN 
    2345       CALL find_str (name(pfid,1:nb_var(pfid)),pvarname,pos) 
     2235    nn = varseq_pos(idf)+1 
     2236    IF (nn > varseq_len(idf)) nn = 1 
     2237!- 
     2238    idv = varseq(idf,nn) 
     2239!- 
     2240    IF (TRIM(W_F(idf)%W_V(idv)%v_name) /= TRIM(pvarname)) THEN 
     2241      CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_var)%v_name,pvarname,pos) 
    23462242      IF (pos > 0) THEN 
    2347         pvid = pos 
     2243        idv = pos 
    23482244      ELSE 
    23492245        CALL ipslerr (3,"histvar_seq", & 
     
    23522248 &  TRIM(pvarname)) 
    23532249      ENDIF 
    2354       varseq_err(pfid) = varseq_err(pfid)+1 
     2250      varseq_err(idf) = varseq_err(idf)+1 
    23552251    ELSE 
    23562252!- 
     
    23592255!---- not defeat the process. 
    23602256!- 
    2361       varseq_pos(pfid) = nn 
    2362     ENDIF 
    2363 !- 
    2364     IF (varseq_err(pfid) .GE. 10) THEN 
    2365       WRITE(str70,'("for file ",I3)') pfid 
     2257      varseq_pos(idf) = nn 
     2258    ENDIF 
     2259!- 
     2260    IF (varseq_err(idf) >= 10) THEN 
     2261      WRITE(str70,'("for file ",I3)') idf 
    23662262      CALL ipslerr (2,"histvar_seq", & 
    23672263 &  'There were 10 errors in the learned sequence of variables',& 
    23682264 &  str70,'This looks like a bug, please report it.') 
    2369          varseq_err(pfid) = 0 
     2265         varseq_err(idf) = 0 
    23702266    ENDIF 
    23712267  ENDIF 
     
    23732269  IF (l_dbg) THEN 
    23742270    WRITE(*,*) & 
    2375  &   'histvar_seq, end of the subroutine :',TRIM(pvarname),pvid 
     2271 &   'histvar_seq, end of the subroutine :',TRIM(pvarname),idv 
    23762272  ENDIF 
    23772273!------------------------- 
    23782274END SUBROUTINE histvar_seq 
    23792275!=== 
    2380 SUBROUTINE histsync (file) 
     2276SUBROUTINE histsync (idf) 
    23812277!--------------------------------------------------------------------- 
    23822278!- This subroutine will synchronise all 
     
    23882284  IMPLICIT NONE 
    23892285!- 
    2390 ! file  : optional argument for fileid 
    2391   INTEGER,INTENT(in),OPTIONAL :: file 
    2392 !- 
    2393   INTEGER :: ifile,ncid,iret 
    2394 !- 
    2395   LOGICAL :: file_exists 
     2286! idf  : optional argument for fileid 
     2287  INTEGER,INTENT(in),OPTIONAL :: idf 
     2288!- 
     2289  INTEGER :: ifile,iret,i_s,i_e 
     2290!- 
    23962291  LOGICAL :: l_dbg 
    23972292!--------------------------------------------------------------------- 
    23982293  CALL ipsldbg (old_status=l_dbg) 
    23992294!- 
    2400   IF (l_dbg) WRITE(*,*) 'Entering loop on files : ',nb_files 
    2401 !- 
    2402 ! 1.The loop on files to synchronise 
    2403 !- 
    2404   DO ifile = 1,nb_files 
    2405 !- 
    2406     IF (PRESENT(file)) THEN 
    2407       file_exists = (ifile == file) 
     2295  IF (l_dbg) THEN 
     2296    WRITE(*,*) "->histsync" 
     2297  ENDIF 
     2298!- 
     2299  IF (PRESENT(idf)) THEN 
     2300    IF ( (idf >= 1).AND.(idf <= nb_files_max) ) THEN 
     2301      IF (W_F(idf)%ncfid > 0) THEN 
     2302        i_s = idf 
     2303        i_e = idf 
     2304      ELSE 
     2305        i_s = 1 
     2306        i_e = 0 
     2307        CALL ipslerr (2,'histsync', & 
     2308 &       'Unable to synchronise the file :','probably','not opened') 
     2309      ENDIF 
    24082310    ELSE 
    2409       file_exists = .TRUE. 
    2410     ENDIF 
    2411 !- 
    2412     IF (file_exists) THEN 
     2311      CALL ipslerr (3,'histsync','Invalid file identifier',' ',' ') 
     2312    ENDIF 
     2313  ELSE 
     2314    i_s = 1 
     2315    i_e = nb_files_max 
     2316  ENDIF 
     2317!- 
     2318  DO ifile=i_s,i_e 
     2319    IF (W_F(ifile)%ncfid > 0) THEN 
    24132320      IF (l_dbg) THEN 
    2414         WRITE(*,*) 'Synchronising specified file number :',file 
     2321        WRITE(*,*) '  histsync - synchronising file number ',ifile 
    24152322      ENDIF 
    2416       ncid = ncdf_ids(ifile) 
    2417       iret = NF90_SYNC (ncid) 
    2418     ENDIF 
    2419 !- 
     2323      iret = NF90_SYNC(W_F(ifile)%ncfid) 
     2324    ENDIF 
    24202325  ENDDO 
     2326!- 
     2327  IF (l_dbg) THEN 
     2328    WRITE(*,*) "<-histsync" 
     2329  ENDIF 
    24212330!---------------------- 
    24222331END SUBROUTINE histsync 
    24232332!=== 
    2424 SUBROUTINE histclo (fid) 
     2333SUBROUTINE histclo (idf) 
    24252334!--------------------------------------------------------------------- 
    24262335!- This subroutine will close all (or one if defined) opened files 
     
    24312340  IMPLICIT NONE 
    24322341!- 
    2433 ! fid  : optional argument for fileid 
    2434   INTEGER,INTENT(in),OPTIONAL :: fid 
    2435 !- 
    2436   INTEGER :: ifile,ncid,iret,iv 
    2437   INTEGER :: start_loop,end_loop 
    2438   CHARACTER(LEN=70) :: str70 
     2342! idf  : optional argument for fileid 
     2343  INTEGER,INTENT(in),OPTIONAL :: idf 
     2344!- 
     2345  INTEGER :: ifile,nfid,nvid,iret,iv,i_s,i_e 
    24392346  LOGICAL :: l_dbg 
    24402347!--------------------------------------------------------------------- 
    24412348  CALL ipsldbg (old_status=l_dbg) 
    24422349!- 
    2443   IF (l_dbg) WRITE(*,*) 'Entering loop on files :',nb_files 
    2444 !- 
    2445   IF (PRESENT(fid)) THEN 
    2446     start_loop = fid 
    2447     end_loop = fid 
     2350  IF (l_dbg) THEN 
     2351    WRITE(*,*) "->histclo" 
     2352  ENDIF 
     2353!- 
     2354  IF (PRESENT(idf)) THEN 
     2355    IF ( (idf >= 1).AND.(idf <= nb_files_max) ) THEN 
     2356      IF (W_F(idf)%ncfid > 0) THEN 
     2357        i_s = idf 
     2358        i_e = idf 
     2359      ELSE 
     2360        i_s = 1 
     2361        i_e = 0 
     2362        CALL ipslerr (2,'histclo', & 
     2363 &       'Unable to close the file :','probably','not opened') 
     2364      ENDIF 
     2365    ELSE 
     2366      CALL ipslerr (3,'histclo','Invalid file identifier',' ',' ') 
     2367    ENDIF 
    24482368  ELSE 
    2449     start_loop = 1 
    2450     end_loop = nb_files 
    2451   ENDIF 
    2452 !- 
    2453   DO ifile=start_loop,end_loop 
    2454     IF (l_dbg) WRITE(*,*) 'Closing specified file number :',ifile 
    2455     ncid = ncdf_ids(ifile) 
    2456     iret = NF90_REDEF (ncid) 
    2457 !--- 
    2458 !-- 1. Loop on the number of variables to add some final information 
    2459 !--- 
    2460     IF (l_dbg) WRITE(*,*) 'Entering loop on vars : ',nb_var(ifile) 
    2461     DO iv=1,nb_var(ifile) 
    2462       IF (hist_wrt_rng(ifile,iv)) THEN 
    2463         IF (l_dbg) THEN 
    2464           WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, & 
    2465          &           ' is : ',hist_minmax(ifile,iv,1) 
    2466           WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, & 
    2467          &           ' is : ',hist_minmax(ifile,iv,2) 
     2369    i_s = 1 
     2370    i_e = nb_files_max 
     2371  ENDIF 
     2372!- 
     2373  DO ifile=i_s,i_e 
     2374    IF (W_F(ifile)%ncfid > 0) THEN 
     2375      IF (l_dbg) THEN 
     2376        WRITE(*,*) '  histclo - closing specified file number :',ifile 
     2377      ENDIF 
     2378      nfid = W_F(ifile)%ncfid 
     2379      iret = NF90_REDEF(nfid) 
     2380!----- 
     2381!---- 1. Loop on the number of variables to add some final information 
     2382!----- 
     2383      IF (l_dbg) THEN 
     2384        WRITE(*,*) '  Entering loop on vars : ',W_F(ifile)%n_var 
     2385      ENDIF 
     2386      DO iv=1,W_F(ifile)%n_var 
     2387!------ Extrema 
     2388        IF (W_F(ifile)%W_V(iv)%hist_wrt_rng) THEN 
     2389          IF (l_dbg) THEN 
     2390            WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, & 
     2391 &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(1) 
     2392            WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, & 
     2393 &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(2) 
     2394          ENDIF 
     2395          IF (W_F(ifile)%W_V(iv)%hist_calc_rng) THEN 
     2396!---------- Put the min and max values on the file 
     2397            nvid = W_F(ifile)%W_V(iv)%ncvid 
     2398            IF (W_F(ifile)%W_V(iv)%v_typ == hist_r8) THEN 
     2399              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', & 
     2400 &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=8)) 
     2401              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', & 
     2402 &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=8)) 
     2403            ELSE 
     2404              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', & 
     2405 &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=4)) 
     2406              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', & 
     2407 &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=4)) 
     2408            ENDIF 
     2409          ENDIF 
    24682410        ENDIF 
    2469         IF (hist_calc_rng(ifile,iv)) THEN 
    2470 !-------- Put the min and max values on the file 
    2471           iret = NF90_PUT_ATT (ncid,ncvar_ids(ifile,iv),'valid_min', & 
    2472  &                             REAL(hist_minmax(ifile,iv,1),KIND=4)) 
    2473           iret = NF90_PUT_ATT (ncid,ncvar_ids(ifile,iv),'valid_max', & 
    2474  &                             REAL(hist_minmax(ifile,iv,2),KIND=4)) 
     2411!------ Time-Buffers 
     2412        IF (ASSOCIATED(W_F(ifile)%W_V(iv)%t_bf)) THEN 
     2413          DEALLOCATE(W_F(ifile)%W_V(iv)%t_bf) 
    24752414        ENDIF 
    2476       ENDIF 
    2477     ENDDO 
    2478 !--- 
    2479 !-- 2. Close the file 
    2480 !--- 
    2481     IF (l_dbg) WRITE(*,*) 'close file :',ncid 
    2482     iret = NF90_CLOSE (ncid) 
    2483     IF (iret /= NF90_NOERR) THEN 
    2484       WRITE(str70,'("This file has been already closed :",I3)') ifile 
    2485       CALL ipslerr (2,'histclo',str70,'','') 
     2415!------ Reinitialize the sizes 
     2416        W_F(ifile)%W_V(iv)%datasz_in(:) = -1 
     2417        W_F(ifile)%W_V(iv)%datasz_max = -1 
     2418      ENDDO 
     2419!----- 
     2420!---- 2. Close the file 
     2421!----- 
     2422      IF (l_dbg) WRITE(*,*) '  close file :',nfid 
     2423      iret = NF90_CLOSE(nfid) 
     2424      W_F(ifile)%ncfid = -1 
     2425      W_F(ifile)%dom_id_svg = -1 
    24862426    ENDIF 
    24872427  ENDDO 
     2428!- 
     2429  IF (l_dbg) THEN 
     2430    WRITE(*,*) "<-histclo" 
     2431  ENDIF 
    24882432!--------------------- 
    24892433END SUBROUTINE histclo 
  • vendors/IOIPSL/current/src/mathelp.f90

    r1895 r1991  
    11MODULE mathelp 
    22!- 
    3 !$Id: mathelp.f90 440 2008-11-26 10:58:38Z bellier $ 
     3!$Id: mathelp.f90 845 2009-12-10 16:26:03Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    2828CONTAINS 
    2929!=== 
    30 SUBROUTINE buildop (str,ex_topps,topp,nbops_max, & 
    31  &                  missing_val,opps,scal,nbops) 
     30SUBROUTINE buildop (c_str,ex_topps,topp,fill_val,opps,scal,nbops) 
    3231!--------------------------------------------------------------------- 
    3332!- This subroutine decomposes the input string in the elementary 
     
    3938!- INPUT 
    4039!- 
    41 !- str      : String containing the operations 
    42 !- ex_toops : The time operations that can be expected 
    43 !-            within the string 
     40!- c_str    : String containing the operations 
     41!- ex_toops : Time operations that can be expected within the string 
     42!- fill_val : 
    4443!- 
    4544!- OUTPUT 
    4645!- 
    47 !--------------------------------------------------------------------- 
    48   IMPLICIT NONE 
    49 !- 
    50   CHARACTER(LEN=80) :: str 
    51   CHARACTER(LEN=*) :: ex_topps 
    52   CHARACTER(LEN=7) :: topp 
    53   INTEGER :: nbops_max,nbops 
    54   CHARACTER(LEN=7) :: opps(nbops_max) 
    55   REAL :: scal(nbops_max),missing_val 
    56 !- 
    57   CHARACTER(LEN=80) :: new_str 
     46!- topp   : Time operation 
     47!- opps   : 
     48!- scal   : 
     49!- nbops  : 
     50!--------------------------------------------------------------------- 
     51  IMPLICIT NONE 
     52!- 
     53  CHARACTER(LEN=*),INTENT(IN) :: c_str,ex_topps 
     54  CHARACTER(LEN=*),INTENT(OUT) :: topp 
     55  CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps 
     56  REAL,INTENT(IN) :: fill_val 
     57  REAL,DIMENSION(:),INTENT(OUT) :: scal 
     58  INTEGER,INTENT(OUT) :: nbops 
     59!- 
     60  CHARACTER(LEN=LEN(c_str)) :: str,new_str 
    5861  INTEGER :: leng,ind_opb,ind_clb 
    5962!- 
     
    6265  IF (check) WRITE(*,*) 'buildop : Some preliminary cleaning' 
    6366!- 
     67  str = c_str 
    6468  leng = LEN_TRIM(str) 
    6569  IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN 
     
    9498 &          ' buildop : Call decoop ',new_str,ind_opb,ind_clb 
    9599        ENDIF 
    96         CALL decoop (new_str,nbops_max,missing_val,opps,scal,nbops) 
     100        CALL decoop (new_str,fill_val,opps,scal,nbops) 
    97101      ELSE 
    98102        CALL ipslerr(3,'buildop', & 
     
    115119END SUBROUTINE buildop 
    116120!=== 
    117 SUBROUTINE decoop (pstr,nbops_max,missing_val,opps,scal,nbops) 
    118 !--------------------------------------------------------------------- 
    119   IMPLICIT NONE 
    120 !- 
    121   CHARACTER(LEN=80) :: pstr 
    122   INTEGER :: nbops_max,nbops 
    123   CHARACTER(LEN=7) :: opps(nbops_max) 
    124   REAL :: scal(nbops_max),missing_val 
    125 !- 
    126   CHARACTER(LEN=1) :: f_char(2),s_char(2) 
    127   INTEGER :: nbsep,f_pos(2),s_pos(2) 
     121SUBROUTINE decoop (pstr,fill_val,opps,scal,nbops) 
     122!--------------------------------------------------------------------- 
     123  IMPLICIT NONE 
     124!- 
     125  CHARACTER(LEN=*),INTENT(IN) :: pstr 
     126  REAL,INTENT(IN) :: fill_val 
     127  CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps 
     128  REAL,DIMENSION(:),INTENT(OUT) :: scal 
     129  INTEGER,INTENT(OUT) :: nbops 
     130!- 
     131  CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char 
     132  INTEGER,DIMENSION(2) :: f_pos,s_pos 
    128133  CHARACTER(LEN=20) :: opp_str,scal_str 
    129   CHARACTER(LEN=80) :: str 
    130   INTEGER :: xpos,leng,ppos,epos,int_tmp 
     134  CHARACTER(LEN=LEN(pstr)) :: str 
     135  INTEGER :: nbsep,nbops_max,xpos,leng,ppos,epos,int_tmp 
    131136  CHARACTER(LEN=3) :: tl,dl 
    132137  CHARACTER(LEN=10) :: fmt 
     
    134139  LOGICAL :: check = .FALSE.,prio 
    135140!--------------------------------------------------------------------- 
    136   IF (check) WRITE(*,'(2a)') ' decoop : Incoming string : ',pstr 
    137 !- 
    138   nbops = 0 
    139   str = pstr 
     141  IF (check) WRITE(*,'(2A)') ' decoop : Incoming string : ',pstr 
     142!- 
     143  str = pstr; nbops = 0; 
    140144!- 
    141145  CALL findsep (str,nbsep,f_char,f_pos,s_char,s_pos) 
    142146  IF (check) WRITE(*,*) 'decoop : Out of findsep',nbsep 
     147!- 
     148  nbops_max = min(SIZE(opps),SIZE(scal)) 
     149!- 
    143150  DO WHILE (nbsep > 0) 
     151    IF (nbops >= nbops_max) THEN 
     152      CALL ipslerr(3,'decoop','Expression too complex',TRIM(str),' ') 
     153    ENDIF 
     154!-- 
    144155    xpos = INDEX(str,'X') 
    145156    leng = LEN_TRIM(str) 
     
    147158!-- 
    148159    IF (check) THEN 
    149       WRITE(*,*) 'decoop : str -->',str(1:leng) 
     160      WRITE(*,*) 'decoop : str   -> ',TRIM(str) 
     161      WRITE(*,*) 'decoop : nbops -> ',nbops 
    150162      WRITE(*,*) s_char(1),'-',f_char(1),'|',f_char(2),'-',s_char(2) 
    151163      WRITE(*,*) s_pos(1),'-',f_pos(1),'|',f_pos(2),'-',s_pos(2) 
    152164    ENDIF 
    153 !-- 
    154     IF (nbops > nbops_max-1) THEN 
    155       CALL ipslerr(3,'decoop','Expression too complex',str,' ') 
    156     ENDIF 
    157 !-- 
    158     IF (check) WRITE(*,*) 'decoop : --',nbops,' ',str(1:leng) 
    159165!--- 
    160166!-- Start the analysis of the syntax. 3 types of constructs 
     
    236242      IF (INDEX(funcs,opp_str(1:LEN_TRIM(opp_str))) > 0) THEN 
    237243        opps(nbops) = opp_str(1:LEN_TRIM(opp_str)) 
    238         scal(nbops) =  missing_val 
     244        scal(nbops) = fill_val 
    239245      ELSE 
    240246        CALL ipslerr(3,'decoop', & 
     
    313319  IMPLICIT NONE 
    314320!- 
    315   CHARACTER(LEN=80) :: str 
     321  CHARACTER(LEN=*),INTENT(INOUT) :: str 
    316322  INTEGER :: nbsep 
    317323  CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char 
    318324  INTEGER,DIMENSION(2) :: f_pos,s_pos 
    319325!- 
    320   CHARACTER(LEN=70) :: str_tmp 
     326  CHARACTER(LEN=10) :: str_tmp 
    321327  LOGICAL :: f_found,s_found 
    322328  INTEGER :: ind,xpos,leng,i 
     
    385391    WRITE(str_tmp,'("number :",I3)') nbsep 
    386392    CALL ipslerr(3,'findsep', & 
    387  &    'How can I find that many separators',str_tmp,str) 
     393 &    'How can I find that many separators',str_tmp,TRIM(str)) 
    388394  ENDIF 
    389395!- 
     
    399405  IMPLICIT NONE 
    400406!- 
    401   CHARACTER(LEN=80) :: str 
     407  CHARACTER(LEN=*),INTENT(INOUT) :: str 
    402408!- 
    403409  INTEGER :: ind,leng,ic,it 
  • vendors/IOIPSL/current/src/stringop.f90

    r1895 r1991  
    11MODULE stringop 
    22!- 
    3 !$Id: stringop.f90 386 2008-09-04 08:38:48Z bellier $ 
     3!$Id: stringop.f90 936 2010-03-04 11:01:32Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
    66! See IOIPSL/IOIPSL_License_CeCILL.txt 
    7 !--------------------------------------------------------------------- 
    8 !- 
    9   INTEGER,DIMENSION(30) :: & 
    10  & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, & 
    11  & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/) 
    12 !- 
    137!--------------------------------------------------------------------- 
    148CONTAINS 
     
    160154END SUBROUTINE struppercase 
    161155!=== 
    162 SUBROUTINE gensig (str,sig) 
     156SUBROUTINE str_xfw (c_string,c_word,l_ok) 
    163157!--------------------------------------------------------------------- 
    164 !- Generate a signature from the first 30 characters of the string 
    165 !- This signature is not unique and thus when one looks for the 
    166 !- one needs to also verify the string. 
     158!- Given a character string "c_string", of arbitrary length, 
     159!- returns a logical flag "l_ok" if a word is found in it, 
     160!- the first word "c_word" if found and the new string "c_string" 
     161!- without the first word "c_word" 
    167162!--------------------------------------------------------------------- 
    168   IMPLICIT NONE 
     163  CHARACTER(LEN=*),INTENT(INOUT) :: c_string 
     164  CHARACTER(LEN=*),INTENT(OUT) :: c_word 
     165  LOGICAL,INTENT(OUT) :: l_ok 
    169166!- 
    170   CHARACTER(LEN=*) :: str 
    171   INTEGER          :: sig 
    172 !- 
    173   INTEGER :: i 
     167  INTEGER :: i_b,i_e 
    174168!--------------------------------------------------------------------- 
    175   sig = 0 
    176   DO i=1,MIN(LEN_TRIM(str),30) 
    177     sig = sig + prime(i)*IACHAR(str(i:i)) 
    178   ENDDO 
    179 !-------------------- 
    180 END SUBROUTINE gensig 
    181 !=== 
    182 SUBROUTINE find_sig (nb_sig,str_tab,str,sig_tab,sig,pos) 
    183 !--------------------------------------------------------------------- 
    184 !- Find the string signature in a list of signatures 
    185 !--------------------------------------------------------------------- 
    186 !- INPUT 
    187 !-   nb_sig      : length of table of signatures 
    188 !-   str_tab     : Table of strings 
    189 !-   str         : Target string we are looking for 
    190 !-   sig_tab     : Table of signatures 
    191 !-   sig         : Target signature we are looking for 
    192 !- OUTPUT 
    193 !-   pos         : -1 if str not found, else value in the table 
    194 !--------------------------------------------------------------------- 
    195   IMPLICIT NONE 
    196 !- 
    197   INTEGER :: nb_sig 
    198   CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab 
    199   CHARACTER(LEN=*) :: str 
    200   INTEGER,DIMENSION(nb_sig) :: sig_tab 
    201   INTEGER :: sig 
    202 !- 
    203   INTEGER :: pos 
    204   INTEGER,DIMENSION(nb_sig) :: loczeros 
    205 !- 
    206   INTEGER :: il,len 
    207   INTEGER,DIMENSION(1) :: minpos 
    208 !--------------------------------------------------------------------- 
    209   pos = -1 
    210   il = LEN_TRIM(str) 
    211 !- 
    212   IF ( nb_sig > 0 ) THEN 
    213     loczeros = ABS(sig_tab(1:nb_sig)-sig) 
    214     IF ( COUNT(loczeros < 1) == 1 ) THEN 
    215       minpos = MINLOC(loczeros) 
    216       len = LEN_TRIM(str_tab(minpos(1))) 
    217       IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) & 
    218           .AND.(len == il) ) THEN 
    219         pos = minpos(1) 
    220       ENDIF 
    221     ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN 
    222       DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 ) 
    223         minpos = MINLOC(loczeros) 
    224         len = LEN_TRIM(str_tab(minpos(1))) 
    225         IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) & 
    226             .AND.(len == il) ) THEN 
    227           pos = minpos(1) 
    228         ELSE 
    229           loczeros(minpos(1)) = 99999 
    230         ENDIF 
    231       ENDDO 
     169  l_ok = (LEN_TRIM(c_string) > 0) 
     170  IF (l_ok) THEN 
     171    i_b = VERIFY(c_string,' ') 
     172    i_e = INDEX(c_string(i_b:),' ') 
     173    IF (i_e == 0) THEN 
     174      c_word = c_string(i_b:) 
     175      c_string = "" 
     176    ELSE 
     177      c_word = c_string(i_b:i_b+i_e-2) 
     178      c_string = ADJUSTL(c_string(i_b+i_e-1:)) 
    232179    ENDIF 
    233180  ENDIF 
    234 !----------------------- 
    235  END SUBROUTINE find_sig 
     181!--------------------- 
     182END SUBROUTINE str_xfw 
    236183!=== 
    237184!------------------ 
  • vendors/IOIPSL/current/tools/flio_rbld.f90

    r1895 r1991  
    11PROGRAM flio_rbld 
    22! 
    3 !$Id: flio_rbld.f90 386 2008-09-04 08:38:48Z bellier $ 
     3!$Id: flio_rbld.f90 1025 2010-05-20 07:49:57Z bellier $ 
    44!- 
    55! This software is governed by the CeCILL license 
     
    602602    ENDIF 
    603603!-- copy all variable attributes 
    604     ALLOCATE(v_a_nm(v_a_nb)) 
    605     CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm) 
    606     DO ia=1,v_a_nb 
    607       CALL fliocpya & 
    608  &     (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), & 
    609  &      f_id_o,TRIM(f_v_nm(iv))) 
    610     ENDDO 
    611     DEALLOCATE(v_a_nm) 
     604    IF (v_a_nb > 0) THEN 
     605      ALLOCATE(v_a_nm(v_a_nb)) 
     606      CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm) 
     607      DO ia=1,v_a_nb 
     608        CALL fliocpya & 
     609 &       (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), & 
     610 &        f_id_o,TRIM(f_v_nm(iv))) 
     611      ENDDO 
     612      DEALLOCATE(v_a_nm) 
     613    ENDIF 
    612614  ENDDO 
    613615!- 
  • vendors/IOIPSL/current/tools/rebuild

    • Property svn:executable set to *
    r1895 r1991  
    11#!/bin/ksh 
    22# 
    3 #$Id: rebuild 386 2008-09-04 08:38:48Z bellier $ 
     3#$Id: rebuild 761 2009-10-26 16:30:14Z bellier $ 
    44# 
    55# This software is governed by the CeCILL license 
     
    100100#- 
    101101${d_n}/flio_rbld < tmp.$$ 
     102r_c=$? 
    102103#- 
    103104# Clear 
     
    107108# End 
    108109#- 
    109 exit 0; 
     110exit ${r_c}; 
Note: See TracChangeset for help on using the changeset viewer.