Changeset 362 for IOIPSL/trunk


Ignore:
Timestamp:
07/25/08 12:58:01 (16 years ago)
Author:
bellier
Message:
  • Updating for more compliance with CF Metadata Convention.
  • Some cleaning
Location:
IOIPSL/trunk/src
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • IOIPSL/trunk/src/fliocom.f90

    r329 r362  
    171171!!   Attributes        Values 
    172172!!   'axis'            "Z" 
    173 !!   'standard_name'   "level" 
     173!!   'standard_name'   "model_level_number" 
    174174!!   'units'           "sigma_level" 
    175175!!   'long_name'       "Sigma Levels" 
    … …  
    613613!! which are spatio-temporal coordinates (x/y/z/t). 
    614614!! 
    615 !!-- Rule 1 : we look for a correct "axis" attribute 
     615!!-- Rule 1 : we look for a variable with one dimension 
     616!!--          and which has the same name as its dimension 
     617!! 
     618!!-- Rule 2 : we look for a correct "axis" attribute 
    616619!! 
    617620!!  Axis       Axis attribute             Number of dimensions 
    … …  
    623626!!    t         T                         1 
    624627!! 
    625 !!-- Rule 2 : we look for a specific name 
    626 !! 
    627 !!  Axis       Names 
    628 !! 
    629 !!    x        'nav_lon' 'lon'     'longitude' 
    630 !!    y        'nav_lat' 'lat'     'latitude' 
    631 !!    z        'depth'   'deptht'  'height'       'level' 
    632 !!             'lev'     'plev'    'sigma_level'  'layer' 
    633 !!    t        'time'    'tstep'   'timesteps' 
    634 !! 
    635 !!-- Rule 3 : we look for a variable with one dimension 
    636 !!--          and which has the same name as its dimension 
     628!!-- Rule 3 : we look for a correct "standard_name" attribute 
     629!! 
     630!!  Axis       Axis attribute          Number of dimensions 
     631!!             (case insensitive) 
     632!! 
     633!!    x         longitude              1/2 
     634!!    y         latitude               1/2 
     635!!    z         model_level_number     1 
     636!!    t         time                   1 
     637!! 
     638!!-- Rule 4 : we look for a specific name 
     639!! 
     640!!  Axis   Names 
     641!! 
     642!!    x    'nav_lon' 'lon'    'longitude' 
     643!!    y    'nav_lat' 'lat'    'latitude' 
     644!!    z    'depth'   'deptht' 'height'      'level' 
     645!!         'lev'     'plev'   'sigma_level' 'layer' 
     646!!    t    'time'    'tstep'  'timesteps' 
     647!! 
    637648!!-------------------------------------------------------------------- 
    638649!- 
    … …  
    921932!- 
    922933! Define "Conventions" global attribute 
    923   i_rc = NF90_PUT_ATT(f_e,NF90_GLOBAL,'Conventions',"CF-1.0") 
     934  i_rc = NF90_PUT_ATT(f_e,NF90_GLOBAL,'Conventions',"CF-1.1") 
    924935!- 
    925936! Add the DOMAIN attributes if needed 
    … …  
    11111122 &                      nw_di(k_1,f_i),levid) 
    11121123    i_rc = NF90_PUT_ATT(f_e,levid,"axis","Z") 
    1113     i_rc = NF90_PUT_ATT(f_e,levid,'standard_name','level') 
     1124    i_rc = NF90_PUT_ATT(f_e,levid,'standard_name','model_level_number') 
    11141125    i_rc = NF90_PUT_ATT(f_e,levid,'units','sigma_level') 
    11151126    i_rc = NF90_PUT_ATT(f_e,levid,'long_name','Sigma Levels') 
    … …  
    48794890  INTEGER :: kv,k,n_r,l_d,n_d,i_rc,dimnb 
    48804891  CHARACTER(LEN=1)  :: c_ax 
     4892  CHARACTER(LEN=9)  :: c_sn 
    48814893  CHARACTER(LEN=15),DIMENSION(10) :: c_r 
    48824894  CHARACTER(LEN=40) :: c_t1,c_t2 
    … …  
    48994911      CASE('x') 
    49004912        l_d = 2 
     4913        c_sn = 'longitude' 
    49014914      CASE('y') 
    49024915        l_d = 2 
     4916        c_sn = 'latitude' 
    49034917      CASE('z') 
    49044918        l_d = 1 
     4919        c_sn = 'model_level_number' 
    49054920      CASE('t') 
    49064921        l_d = 1 
     4922        c_sn = 'time' 
    49074923      END SELECT 
    49084924!--- 
    4909 !-- Rule 1 : we look for a correct "axis" attribute 
    4910 !--- 
    4911     IF (i_v < 0) THEN 
    4912       L_R1: DO kv=1,nw_nv(f_i) 
    4913         i_rc = NF90_GET_ATT(nw_id(f_i),kv,'axis',c_t1) 
    4914         IF (i_rc == NF90_NOERR) THEN 
    4915           CALL strlowercase (c_t1) 
    4916           IF (TRIM(c_t1) == c_ax) THEN 
    4917             i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d) 
    4918             IF (n_d <= l_d) THEN 
    4919               i_v = kv; nbd = n_d; 
    4920               EXIT L_R1 
    4921             ENDIF 
    4922           ENDIF 
    4923         ENDIF 
    4924       ENDDO L_R1 
    4925     ENDIF 
    4926 !--- 
    4927 !-- Rule 2 : we look for a specific name 
    4928 !--- 
    4929     IF (i_v < 0) THEN 
    4930       SELECT CASE (c_ax) 
    4931       CASE('x') 
    4932         n_r = 3 
    4933         c_r(1)='nav_lon'; c_r(2)='lon'; c_r(3)='longitude'; 
    4934       CASE('y') 
    4935         n_r = 3 
    4936         c_r(1)='nav_lat'; c_r(2)='lat'; c_r(3)='latitude'; 
    4937       CASE('z') 
    4938         n_r = 8 
    4939         c_r(1)='depth'; c_r(2)='deptht'; c_r(3)='height'; 
    4940         c_r(4)='level'; c_r(5)='lev'; c_r(6)='plev'; 
    4941         c_r(7)='sigma_level'; c_r(8)='layer'; 
    4942       CASE('t') 
    4943         n_r = 3 
    4944         c_r(1)='time'; c_r(2)='tstep'; c_r(3)='timesteps'; 
    4945       END SELECT 
    4946 !----- 
    4947       L_R2: DO kv=1,nw_nv(f_i) 
    4948         i_rc = NF90_INQUIRE_VARIABLE & 
    4949  &               (nw_id(f_i),kv,name=c_t1,ndims=n_d) 
    4950         IF (i_rc == NF90_NOERR) THEN 
    4951           CALL strlowercase (c_t1) 
    4952           IF (n_d <= l_d) THEN 
    4953             DO k=1,n_r 
    4954               IF (TRIM(c_t1) == TRIM(c_r(k))) THEN 
    4955                 i_v = kv; nbd = n_d; 
    4956                 EXIT L_R2 
    4957               ENDIF 
    4958             ENDDO 
    4959           ENDIF 
    4960         ENDIF 
    4961       ENDDO L_R2 
    4962     ENDIF 
    4963 !--- 
    4964 !-- Rule 3 : we look for a variable with one dimension 
    4965 !--          and which has the same name as its dimension 
     4925!-- Rule 1 : we look for a variable with one dimension 
     4926!--          and which has the same name as its dimension (NUG) 
    49664927!--- 
    49674928    IF (i_v < 0) THEN 
    … …  
    49854946      IF (i_rc == NF90_NOERR) THEN 
    49864947        CALL strlowercase (c_t1) 
    4987         L_R3: DO kv=1,nw_nv(f_i) 
     4948        L_R1: DO kv=1,nw_nv(f_i) 
    49884949          i_rc = NF90_INQUIRE_VARIABLE & 
    49894950 &                 (nw_id(f_i),kv,name=c_t2,ndims=n_d) 
    … …  
    49924953            IF (TRIM(c_t1) == TRIM(c_t2)) THEN 
    49934954              i_v = kv; nbd = n_d; 
     4955              EXIT L_R1 
     4956            ENDIF 
     4957          ENDIF 
     4958        ENDDO L_R1 
     4959      ENDIF 
     4960    ENDIF 
     4961!--- 
     4962!-- Rule 2 : we look for a correct "axis" attribute (CF) 
     4963!--- 
     4964    IF (i_v < 0) THEN 
     4965      L_R2: DO kv=1,nw_nv(f_i) 
     4966        i_rc = NF90_GET_ATT(nw_id(f_i),kv,'axis',c_t1) 
     4967        IF (i_rc == NF90_NOERR) THEN 
     4968          CALL strlowercase (c_t1) 
     4969          IF (TRIM(c_t1) == c_ax) THEN 
     4970            i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d) 
     4971            IF (n_d <= l_d) THEN 
     4972              i_v = kv; nbd = n_d; 
     4973              EXIT L_R2 
     4974            ENDIF 
     4975          ENDIF 
     4976        ENDIF 
     4977      ENDDO L_R2 
     4978    ENDIF 
     4979!--- 
     4980!-- Rule 3 : we look for a correct "standard_name" attribute (CF) 
     4981!--- 
     4982    IF (i_v < 0) THEN 
     4983      L_R3: DO kv=1,nw_nv(f_i) 
     4984        i_rc = NF90_GET_ATT(nw_id(f_i),kv,'standard_name',c_t1) 
     4985        IF (i_rc == NF90_NOERR) THEN 
     4986          CALL strlowercase (c_t1) 
     4987          IF (TRIM(c_t1) == TRIM(c_sn)) THEN 
     4988            i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d) 
     4989            IF (n_d <= l_d) THEN 
     4990              i_v = kv; nbd = n_d; 
    49944991              EXIT L_R3 
    49954992            ENDIF 
    49964993          ENDIF 
    4997         ENDDO L_R3 
    4998       ENDIF 
     4994        ENDIF 
     4995      ENDDO L_R3 
     4996    ENDIF 
     4997!--- 
     4998!-- Rule 4 : we look for a specific name (IOIPSL) 
     4999!--- 
     5000    IF (i_v < 0) THEN 
     5001      SELECT CASE (c_ax) 
     5002      CASE('x') 
     5003        n_r = 3 
     5004        c_r(1)='nav_lon'; c_r(2)='lon'; c_r(3)='longitude'; 
     5005      CASE('y') 
     5006        n_r = 3 
     5007        c_r(1)='nav_lat'; c_r(2)='lat'; c_r(3)='latitude'; 
     5008      CASE('z') 
     5009        n_r = 8 
     5010        c_r(1)='depth'; c_r(2)='deptht'; c_r(3)='height'; 
     5011        c_r(4)='level'; c_r(5)='lev'; c_r(6)='plev'; 
     5012        c_r(7)='sigma_level'; c_r(8)='layer'; 
     5013      CASE('t') 
     5014        n_r = 3 
     5015        c_r(1)='time'; c_r(2)='tstep'; c_r(3)='timesteps'; 
     5016      END SELECT 
     5017!----- 
     5018      L_R4: DO kv=1,nw_nv(f_i) 
     5019        i_rc = NF90_INQUIRE_VARIABLE & 
     5020 &               (nw_id(f_i),kv,name=c_t1,ndims=n_d) 
     5021        IF (i_rc == NF90_NOERR) THEN 
     5022          CALL strlowercase (c_t1) 
     5023          IF (n_d <= l_d) THEN 
     5024            DO k=1,n_r 
     5025              IF (TRIM(c_t1) == TRIM(c_r(k))) THEN 
     5026                i_v = kv; nbd = n_d; 
     5027                EXIT L_R4 
     5028              ENDIF 
     5029            ENDDO 
     5030          ENDIF 
     5031        ENDIF 
     5032      ENDDO L_R4 
    49995033    ENDIF 
    50005034!--- 

  • IOIPSL/trunk/src/histcom.f90

    r358 r362  
    55  USE netcdf 
    66!- 
    7   USE stringop,  ONLY : nocomma,cmpblank,findpos,find_str,strlowercase 
    8   USE mathelp,   ONLY : mathop,moycum,trans_buff,buildop 
    9   USE fliocom,   ONLY : flio_dom_file,flio_dom_att 
     7  USE stringop, ONLY : nocomma,cmpblank,findpos,find_str,strlowercase 
     8  USE mathelp,  ONLY : mathop,moycum,trans_buff,buildop 
     9  USE fliocom,  ONLY : flio_dom_file,flio_dom_att 
    1010  USE calendar 
    1111  USE errioipsl, ONLY : ipslerr 
    … …  
    1414!- 
    1515  PRIVATE 
    16   PUBLIC :: histbeg, histdef, histhori, histvert, histend, & 
    17  &          histwrite, histclo, histsync, ioconf_modname 
     16  PUBLIC :: histbeg,histdef,histhori,histvert,histend, & 
     17 &          histwrite,histclo,histsync,ioconf_modname 
    1818!--------------------------------------------------------------------- 
    1919!- Some confusing vocabulary in this code ! 
    … …  
    7070! Fixed parameter 
    7171!- 
    72   INTEGER,PARAMETER :: nb_files_max=20, nb_var_max=400, & 
    73  &                     nb_hax_max=5, nb_zax_max=10, nbopp_max=10 
     72  INTEGER,PARAMETER :: nb_files_max=20,nb_var_max=400, & 
     73 &                     nb_hax_max=5,nb_zax_max=10,nbopp_max=10 
    7474  REAL,PARAMETER :: missing_val=nf90_fill_real 
    7575!- 
    … …  
    145145  INTEGER,SAVE :: buff_pos=0 
    146146  REAL,ALLOCATABLE,SAVE :: buffer(:) 
    147   LOGICAL,SAVE :: & 
    148  &  zoom(nb_files_max)=.FALSE., regular(nb_files_max)=.TRUE. 
     147  LOGICAL,DIMENSION(nb_files_max),SAVE :: zoom=.FALSE.,regular=.TRUE. 
    149148!- 
    150149! Book keeping of the axes 
    … …  
    170169!=== 
    171170!- 
    172 SUBROUTINE histbeg_totreg                     & 
    173  & (pfilename, pim, plon, pjm, plat,          & 
    174  &  par_orix, par_szx, par_oriy, par_szy,     & 
    175  &  pitau0, pdate0, pdeltat, phoriid, pfileid, domain_id) 
     171SUBROUTINE histbeg_totreg                 & 
     172 & (pfilename,pim,plon,pjm,plat,          & 
     173 &  par_orix,par_szx,par_oriy,par_szy,    & 
     174 &  pitau0,pdate0,pdeltat,phoriid,pfileid,domain_id) 
    176175!--------------------------------------------------------------------- 
    177176!- This is just an interface for histbeg_regular in case when 
    … …  
    200199!- pdate0    : The Julian date at which the itau was equal to 0 
    201200!- pdeltat   : Time step in seconds. Time step of the counter itau 
    202 !-             used in histwrt for instance 
     201!-             used in histwrte for instance 
    203202!- 
    204203!- OUTPUT 
    … …  
    251250 &   .TRUE.,domain_id) 
    252251!- 
    253   DEALLOCATE (lon_tmp, lat_tmp) 
     252  DEALLOCATE (lon_tmp,lat_tmp) 
    254253!---------------------------- 
    255254END SUBROUTINE histbeg_totreg 
    256255!=== 
    257256SUBROUTINE histbeg_regular & 
    258  & (pfilename, pim, plon, pjm, plat,         & 
    259  &  par_orix, par_szx, par_oriy, par_szy,    & 
    260  &  pitau0, pdate0, pdeltat, phoriid, pfileid, & 
    261  &  opt_rectilinear, domain_id) 
     257 & (pfilename,pim,plon,pjm,plat,           & 
     258 &  par_orix,par_szx,par_oriy,par_szy,     & 
     259 &  pitau0,pdate0,pdeltat,phoriid,pfileid, & 
     260 &  opt_rectilinear,domain_id) 
    262261!--------------------------------------------------------------------- 
    263262!- This subroutine initializes a netcdf file and returns the ID. 
    … …  
    287286!- pdate0    : The Julian date at which the itau was equal to 0 
    288287!- pdeltat   : Time step in seconds. Time step of the counter itau 
    289 !-             used in histwrt for instance 
     288!-             used in histwrte for instance 
    290289!- 
    291290!- OUTPUT 
    … …  
    353352    CALL ipslerr (3,"histbeg", & 
    354353   &  'Table of files too small. You should increase nb_files_max', & 
    355    &  'in histcom.f90 in order to accomodate all these files', ' ') 
     354   &  'in histcom.f90 in order to accomodate all these files',' ') 
    356355  ENDIF 
    357356!- 
    … …  
    361360  nb_zax(pfileid) = 0 
    362361!- 
    363   slab_ori(pfileid,1:2) = (/ par_orix, par_oriy /) 
    364   slab_sz(pfileid,1:2)  = (/ par_szx,  par_szy  /) 
     362  slab_ori(pfileid,1:2) = (/ par_orix,par_oriy /) 
     363  slab_sz(pfileid,1:2)  = (/ par_szx, par_szy  /) 
    365364!- 
    366365! 3.0 Opening netcdf file and defining dimensions 
    … …  
    389388! 4.3 Global attributes 
    390389!- 
    391   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.3') 
     390  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1') 
    392391  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file)) 
    393392  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name)) 
    … …  
    404403  ENDIF 
    405404  ncdf_ids(pfileid) = ncid 
    406   full_size(pfileid,1:2) = (/ pim, pjm /) 
     405  full_size(pfileid,1:2) = (/ pim,pjm /) 
    407406!- 
    408407! 6.0 storing the geographical coordinates 
    … …  
    411410  regular(pfileid)=.TRUE. 
    412411!- 
    413   CALL histhori_regular (pfileid, pim, plon, pjm, plat, & 
    414  &  ' ' , 'Default grid', phoriid, rectilinear) 
     412  CALL histhori_regular (pfileid,pim,plon,pjm,plat, & 
     413 &  ' ' ,'Default grid',phoriid,rectilinear) 
    415414!----------------------------- 
    416415END SUBROUTINE histbeg_regular 
    417416!=== 
    418417SUBROUTINE histbeg_irregular & 
    419  &  (pfilename, pim, plon, plon_bounds, plat, plat_bounds,   & 
    420  &   pitau0, pdate0, pdeltat, phoriid, pfileid, domain_id) 
     418 &  (pfilename,pim,plon,plon_bounds,plat,plat_bounds,   & 
     419 &   pitau0,pdate0,pdeltat,phoriid,pfileid,domain_id) 
    421420!--------------------------------------------------------------------- 
    422421!- This subroutine initializes a netcdf file and returns the ID. 
    … …  
    438437!- pdate0    : The Julian date at which the itau was equal to 0 
    439438!- pdeltat   : Time step in seconds. Time step of the counter itau 
    440 !-             used in histwrt for instance 
     439!-             used in histwrte for instance 
    441440!- 
    442441!- OUTPUT 
    … …  
    503502  nb_zax(pfileid) = 0 
    504503!- 
    505   slab_ori(pfileid,1:2) = (/ 1, 1 /) 
    506   slab_sz(pfileid,1:2)  = (/ pim, 1 /) 
     504  slab_ori(pfileid,1:2) = (/ 1,1 /) 
     505  slab_sz(pfileid,1:2)  = (/ pim,1 /) 
    507506!- 
    508507! 3.0 Opening netcdf file and defining dimensions 
    … …  
    520519  yid(nb_files) = 0 
    521520!- 
    522 !- 4.0 Declaring the geographical coordinates and other attributes 
    523 !- 
    524    IF (check) WRITE(*,*) "histbeg_irregular 4.0" 
     521! 4.0 Declaring the geographical coordinates and other attributes 
     522!- 
     523  IF (check) WRITE(*,*) "histbeg_irregular 4.0" 
    525524!- 
    526525! 4.3 Global attributes 
    527526!- 
    528   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.3') 
     527  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1') 
    529528  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file)) 
    530529  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name)) 
    … …  
    541540  ENDIF 
    542541  ncdf_ids(pfileid) = ncid 
    543   full_size(pfileid,1:2) = (/ pim, 1 /) 
     542  full_size(pfileid,1:2) = (/ pim,1 /) 
    544543!- 
    545544! 6.0 storing the geographical coordinates 
    … …  
    549548!- 
    550549  CALL histhori_irregular & 
    551  &  (pfileid, pim, plon, plon_bounds, plat, plat_bounds, & 
    552  &   ' ' , 'Default grid', phoriid) 
     550 &  (pfileid,pim,plon,plon_bounds,plat,plat_bounds, & 
     551 &   ' ' ,'Default grid',phoriid) 
    553552!------------------------------- 
    554553END SUBROUTINE histbeg_irregular 
    … …  
    586585  IMPLICIT NONE 
    587586!- 
    588   INTEGER,INTENT(IN) :: pfileid, pim, pjm 
    589   REAL,INTENT(IN),DIMENSION(pim,pjm) :: plon, plat 
    590   CHARACTER(LEN=*),INTENT(IN) :: phname, phtitle 
     587  INTEGER,INTENT(IN) :: pfileid,pim,pjm 
     588  REAL,INTENT(IN),DIMENSION(pim,pjm) :: plon,plat 
     589  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle 
    591590  INTEGER,INTENT(OUT) :: phid 
    592591  LOGICAL,INTENT(IN),OPTIONAL :: opt_rectilinear 
    593592!- 
    594   CHARACTER(LEN=25) :: lon_name, lat_name 
    595   CHARACTER(LEN=80) :: tmp_title, tmp_name 
     593  CHARACTER(LEN=25) :: lon_name,lat_name 
     594  CHARACTER(LEN=80) :: tmp_title,tmp_name 
    596595  INTEGER :: ndim 
    597596  INTEGER,DIMENSION(2) :: dims 
    598   INTEGER :: nlonid, nlatid 
    599   INTEGER :: orix, oriy, par_szx, par_szy 
    600   INTEGER :: iret, ncid 
     597  INTEGER :: nlonid,nlatid 
     598  INTEGER :: orix,oriy,par_szx,par_szy 
     599  INTEGER :: iret,ncid 
    601600  LOGICAL :: rectilinear 
    602601!- 
    … …  
    627626!- 
    628627  ndim = 2 
    629   dims(1:2) = (/ xid(pfileid), yid(pfileid) /) 
     628  dims(1:2) = (/ xid(pfileid),yid(pfileid) /) 
    630629!- 
    631630  tmp_name = phname 
    … …  
    653652  nb_hax(pfileid) = phid 
    654653!- 
    655   hax_name(pfileid,phid,1:2) = (/ lon_name, lat_name /) 
     654  hax_name(pfileid,phid,1:2) = (/ lon_name,lat_name /) 
    656655  tmp_title = phtitle 
    657656!- 
    … …  
    665664  ENDIF 
    666665  iret = NF90_DEF_VAR (ncid,lon_name,NF90_FLOAT,dims(1:ndim),nlonid) 
    667   iret = NF90_PUT_ATT (ncid,nlonid,'axis',"X") 
     666  IF (rectilinear) THEN 
     667    iret = NF90_PUT_ATT (ncid,nlonid,'axis',"X") 
     668  ENDIF 
     669  iret = NF90_PUT_ATT (ncid,nlonid,'standard_name',"longitude") 
    668670  iret = NF90_PUT_ATT (ncid,nlonid,'units',"degrees_east") 
    669671  iret = NF90_PUT_ATT (ncid,nlonid,'valid_min', & 
    … …  
    683685  ENDIF 
    684686  iret = NF90_DEF_VAR (ncid,lat_name,NF90_FLOAT,dims(1:ndim),nlatid) 
    685   iret = NF90_PUT_ATT (ncid,nlatid,'axis',"Y") 
     687  IF (rectilinear) THEN 
     688    iret = NF90_PUT_ATT (ncid,nlatid,'axis',"Y") 
     689  ENDIF 
     690  iret = NF90_PUT_ATT (ncid,nlatid,'standard_name',"latitude") 
    686691  iret = NF90_PUT_ATT (ncid,nlatid,'units',"degrees_north") 
    687692  iret = NF90_PUT_ATT (ncid,nlatid,'valid_min', & 
    … …  
    726731!=== 
    727732SUBROUTINE histhori_irregular & 
    728  &  (pfileid, pim, plon, plon_bounds, plat, plat_bounds, & 
    729  &   phname, phtitle, phid) 
     733 &  (pfileid,pim,plon,plon_bounds,plat,plat_bounds, & 
     734 &   phname,phtitle,phid) 
    730735!--------------------------------------------------------------------- 
    731736!- This subroutine is made to declare a new horizontale grid. 
    … …  
    754759  IMPLICIT NONE 
    755760!- 
    756   INTEGER,INTENT(IN) :: pfileid, pim 
    757   REAL,DIMENSION(pim),INTENT(IN) :: plon, plat 
    758   REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds, plat_bounds 
    759   CHARACTER(LEN=*), INTENT(IN) :: phname, phtitle 
     761  INTEGER,INTENT(IN) :: pfileid,pim 
     762  REAL,DIMENSION(pim),INTENT(IN) :: plon,plat 
     763  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds 
     764  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle 
    760765  INTEGER,INTENT(OUT) :: phid 
    761766!- 
    762   CHARACTER(LEN=25) :: lon_name, lat_name 
    763   CHARACTER(LEN=30) :: lonbound_name, latbound_name 
    764   CHARACTER(LEN=80) :: tmp_title, tmp_name, longname 
    765   INTEGER :: ndim, dims(2) 
    766   INTEGER :: ndimb, dimsb(2) 
     767  CHARACTER(LEN=25) :: lon_name,lat_name 
     768  CHARACTER(LEN=30) :: lonbound_name,latbound_name 
     769  CHARACTER(LEN=80) :: tmp_title,tmp_name,longname 
     770  INTEGER :: ndim,dims(2) 
     771  INTEGER :: ndimb,dimsb(2) 
    767772  INTEGER :: nbbounds 
    768   INTEGER :: nlonid, nlatid, nlonidb, nlatidb 
    769   INTEGER :: iret, ncid, twoid 
     773  INTEGER :: nlonid,nlatid,nlonidb,nlatidb 
     774  INTEGER :: iret,ncid,twoid 
    770775  LOGICAL :: transp = .FALSE. 
    771   REAL, ALLOCATABLE, DIMENSION(:,:) :: bounds_trans 
     776  REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans 
    772777!- 
    773778  LOGICAL :: check = .FALSE. 
    … …  
    807812  ENDIF 
    808813!- 
    809   iret = NF90_DEF_DIM (ncid, 'nbnd', nbbounds, twoid) 
     814  iret = NF90_DEF_DIM (ncid,'nbnd',nbbounds,twoid) 
    810815  ndim = 1 
    811816  dims(1) = xid(pfileid) 
    812817  ndimb = 2 
    813   dimsb(1:2) = (/ twoid, xid(pfileid) /) 
     818  dimsb(1:2) = (/ twoid,xid(pfileid) /) 
    814819!- 
    815820  tmp_name = phname 
    … …  
    829834  nb_hax(pfileid) = phid 
    830835!- 
    831   hax_name(pfileid,phid,1:2) = (/ lon_name, lat_name /) 
     836  hax_name(pfileid,phid,1:2) = (/ lon_name,lat_name /) 
    832837  tmp_title = phtitle 
    833838!- 
    … …  
    837842!- 
    838843  iret = NF90_DEF_VAR (ncid,lon_name,NF90_FLOAT,dims(1:ndim),nlonid) 
    839   iret = NF90_PUT_ATT (ncid,nlonid,'axis',"X") 
     844  iret = NF90_PUT_ATT (ncid,nlonid,'standard_name',"longitude") 
    840845  iret = NF90_PUT_ATT (ncid,nlonid,'units',"degrees_east") 
    841846  iret = NF90_PUT_ATT (ncid,nlonid,'valid_min', & 
    … …  
    859864!- 
    860865  iret = NF90_DEF_VAR (ncid,lat_name,NF90_FLOAT,dims(1:ndim),nlatid) 
    861   iret = NF90_PUT_ATT (ncid,nlatid,'axis',"Y") 
     866  iret = NF90_PUT_ATT (ncid,nlatid,'standard_name',"latitude") 
    862867  iret = NF90_PUT_ATT (ncid,nlatid,'units',"degrees_north") 
    863868  iret = NF90_PUT_ATT (ncid,nlatid,'valid_min', & 
    … …  
    884889! 4.1 Write the longitude 
    885890!- 
    886   iret = NF90_PUT_VAR (ncid, nlonid, plon(1:pim)) 
     891  iret = NF90_PUT_VAR (ncid,nlonid,plon(1:pim)) 
    887892!- 
    888893! 4.2 Write the longitude bounds 
    … …  
    893898    bounds_trans = plon_bounds 
    894899  ENDIF 
    895   iret = NF90_PUT_VAR (ncid, nlonidb, bounds_trans(1:nbbounds,1:pim)) 
     900  iret = NF90_PUT_VAR (ncid,nlonidb,bounds_trans(1:nbbounds,1:pim)) 
    896901!- 
    897902! 4.3 Write the latitude 
    898903!- 
    899   iret = NF90_PUT_VAR (ncid, nlatid, plat(1:pim)) 
     904  iret = NF90_PUT_VAR (ncid,nlatid,plat(1:pim)) 
    900905!- 
    901906! 4.4 Write the latitude bounds 
    … …  
    944949  CHARACTER(LEN=*),INTENT(IN) :: pzaxname,pzaxunit,pzaxtitle 
    945950  REAL,INTENT(IN) :: pzvalues(pzsize) 
    946   INTEGER, INTENT(OUT) :: pzaxid 
     951  INTEGER,INTENT(OUT) :: pzaxid 
    947952  CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: pdirect 
    948953!- 
    … …  
    951956  CHARACTER(LEN=80) :: str80 
    952957  CHARACTER(LEN=20) :: direction 
    953   INTEGER :: iret, leng, ncid 
     958  INTEGER :: iret,leng,ncid 
    954959  LOGICAL :: check = .FALSE. 
    955960!--------------------------------------------------------------------- 
    … …  
    981986    CALL ipslerr (2,"histvert",& 
    982987   & "The specified direction for the vertical axis is not possible.",& 
    983    & "it is replaced by : unknown", str80) 
     988   & "it is replaced by : unknown",str80) 
    984989  ENDIF 
    985990!- 
    … …  
    10201025 &                     zaxid_tmp,zdimid) 
    10211026  iret = NF90_PUT_ATT (ncid,zdimid,'axis',"Z") 
     1027  iret = NF90_PUT_ATT (ncid,zdimid,'standard_name',"model_level_number") 
    10221028  leng = MIN(LEN_TRIM(pzaxunit),20) 
    10231029  IF (leng > 0) THEN 
    … …  
    10461052!- 
    10471053  nb_zax(pfileid) = iv 
    1048   zax_size(pfileid, iv) = pzsize 
    1049   zax_name(pfileid, iv) = pzaxname 
    1050   zax_ids(pfileid, iv) = zaxid_tmp 
     1054  zax_size(pfileid,iv) = pzsize 
     1055  zax_name(pfileid,iv) = pzaxname 
     1056  zax_ids(pfileid,iv) = zaxid_tmp 
    10511057  pzaxid =  iv 
    10521058!---------------------- 
    10531059END SUBROUTINE histvert 
    10541060!=== 
    1055 SUBROUTINE histdef (pfileid, pvarname, ptitle, punit, & 
    1056  &                  pxsize, pysize, phoriid, pzsize,  & 
    1057  &                  par_oriz, par_szz, pzid,          & 
    1058  &                  pnbbyt, popp, pfreq_opp, pfreq_wrt, var_range) 
     1061SUBROUTINE histdef (pfileid,pvarname,ptitle,punit, & 
     1062 &                  pxsize,pysize,phoriid,pzsize,  & 
     1063 &                  par_oriz,par_szz,pzid,         & 
     1064 &                  pnbbyt,popp,pfreq_opp,pfreq_wrt,var_range) 
    10591065!--------------------------------------------------------------------- 
    10601066!- With this subroutine each variable to be archived on the history 
    … …  
    11071113  IMPLICIT NONE 
    11081114!- 
    1109   INTEGER,INTENT(IN) :: pfileid, pxsize, pysize, pzsize, pzid 
    1110   INTEGER,INTENT(IN) :: par_oriz, par_szz, pnbbyt, phoriid 
    1111   CHARACTER(LEN=*),INTENT(IN) :: pvarname, punit, popp 
    1112   CHARACTER(LEN=*),INTENT(IN) :: ptitle 
    1113   REAL,INTENT(IN) :: pfreq_opp, pfreq_wrt 
     1115  INTEGER,INTENT(IN) :: pfileid,pxsize,pysize,pzsize,pzid 
     1116  INTEGER,INTENT(IN) :: par_oriz,par_szz,pnbbyt,phoriid 
     1117  CHARACTER(LEN=*),INTENT(IN) :: pvarname,punit,popp,ptitle 
     1118  REAL,INTENT(IN) :: pfreq_opp,pfreq_wrt 
    11141119  REAL,DIMENSION(2),OPTIONAL,INTENT(IN) :: var_range 
    11151120!- 
    11161121  INTEGER :: iv,i 
    1117   CHARACTER(LEN=70) :: str70, str71, str72 
     1122  CHARACTER(LEN=70) :: str70,str71,str72 
    11181123  CHARACTER(LEN=20) :: tmp_name 
    11191124  CHARACTER(LEN=40) :: str40 
    11201125  CHARACTER(LEN=10) :: str10 
    11211126  CHARACTER(LEN=80) :: tmp_str80 
    1122   CHARACTER(LEN=7) :: tmp_topp, tmp_sopp(nbopp_max) 
     1127  CHARACTER(LEN=7) :: tmp_topp,tmp_sopp(nbopp_max) 
    11231128  CHARACTER(LEN=120) :: ex_topps 
    1124   REAL :: tmp_scal(nbopp_max), un_an, un_jour, test_fopp, test_fwrt 
    1125   INTEGER :: pos, buff_sz 
     1129  REAL :: tmp_scal(nbopp_max),un_an,un_jour,test_fopp,test_fwrt 
     1130  INTEGER :: pos,buff_sz 
    11261131!- 
    11271132  LOGICAL :: check = .FALSE. 
    … …  
    11551160 &    TRIM(pvarname),pfileid 
    11561161    str72 = "Can also be a wrong file ID in another declaration" 
    1157     CALL ipslerr (3,"histdef", str70, str71, str72) 
     1162    CALL ipslerr (3,"histdef",str70,str71,str72) 
    11581163  ENDIF 
    11591164!- 
    … …  
    11681173  tmp_str80 = popp 
    11691174  CALL buildop & 
    1170  &  (tmp_str80, ex_topps, tmp_topp, nbopp_max, missing_val, & 
    1171  &   tmp_sopp, tmp_scal, nbopp(pfileid,iv)) 
     1175 &  (tmp_str80,ex_topps,tmp_topp,nbopp_max,missing_val, & 
     1176 &   tmp_sopp,tmp_scal,nbopp(pfileid,iv)) 
    11721177!- 
    11731178  topp(pfileid,iv) = tmp_topp 
    … …  
    11891194!- 
    11901195  IF (check) & 
    1191  &  WRITE(*,*) "histdef : 2.0", pfileid,iv,nbopp(pfileid,iv), & 
     1196 &  WRITE(*,*) "histdef : 2.0",pfileid,iv,nbopp(pfileid,iv), & 
    11921197 &    sopps(pfileid,iv,1:nbopp(pfileid,iv)), & 
    11931198 &    scal(pfileid,iv,1:nbopp(pfileid,iv)) 
    11941199!- 
    1195   scsize(pfileid,iv,1:3) = (/ pxsize, pysize, pzsize /) 
     1200  scsize(pfileid,iv,1:3) = (/ pxsize,pysize,pzsize /) 
    11961201!- 
    11971202  zorig(pfileid,iv,1:3) = & 
    1198  &  (/ slab_ori(pfileid,1), slab_ori(pfileid,2), par_oriz /) 
     1203 &  (/ slab_ori(pfileid,1),slab_ori(pfileid,2),par_oriz /) 
    11991204!- 
    12001205  zsize(pfileid,iv,1:3) = & 
    1201  &  (/ slab_sz(pfileid,1), slab_sz(pfileid,2), par_szz /) 
     1206 &  (/ slab_sz(pfileid,1),slab_sz(pfileid,2),par_szz /) 
    12021207!- 
    12031208! Is the size of the full array the same as that of the coordinates  ? 
    … …  
    12081213    str70 = "The size of the variable is different "// & 
    12091214 &          "from the one of the coordinates" 
    1210     WRITE(str71,'("Size of coordinates :", 2I4)') & 
    1211  &   full_size(pfileid,1), full_size(pfileid,2) 
     1215    WRITE(str71,'("Size of coordinates :",2I4)') & 
     1216 &   full_size(pfileid,1),full_size(pfileid,2) 
    12121217    WRITE(str72,'("Size declared for variable ",a," :",2I4)') & 
    1213  &   TRIM(tmp_name), pxsize, pysize 
    1214     CALL ipslerr (3,"histdef", str70, str71, str72) 
     1218 &   TRIM(tmp_name),pxsize,pysize 
     1219    CALL ipslerr (3,"histdef",str70,str71,str72) 
    12151220  ENDIF 
    12161221!- 
    … …  
    12211226    str70 = & 
    12221227 &   "Size of variable should be greater or equal to those of the zoom" 
    1223     WRITE(str71,'("Size of XY zoom :", 2I4)') & 
     1228    WRITE(str71,'("Size of XY zoom :",2I4)') & 
    12241229 &   slab_sz(pfileid,1),slab_sz(pfileid,1) 
    12251230    WRITE(str72,'("Size declared for variable ",a," :",2I4)') & 
    1226  &   TRIM(tmp_name), pxsize, pysize 
    1227     CALL ipslerr (3,"histdef", str70, str71, str72) 
     1231 &   TRIM(tmp_name),pxsize,pysize 
     1232    CALL ipslerr (3,"histdef",str70,str71,str72) 
    12281233  ENDIF 
    12291234!- 
    … …  
    12371242    CALL ipslerr (2,"histdef", & 
    12381243   &  'We use the default grid for variable as an invalide',& 
    1239    &  'ID was provided for variable : ', pvarname) 
     1244   &  'ID was provided for variable : ',TRIM(pvarname)) 
    12401245  ENDIF 
    12411246!- 
    … …  
    12511256 &     TRIM(tmp_name) 
    12521257      str71 = " Does not exist." 
    1253       CALL ipslerr (3,"histdef",str70,str71, " ") 
     1258      CALL ipslerr (3,"histdef",str70,str71," ") 
    12541259    ENDIF 
    12551260!- 
    … …  
    12591264      str70 = "The size of the zoom does not correspond "// & 
    12601265 &            "to the size of the chosen vertical axis" 
    1261       WRITE(str71,'("Size of zoom in z :", I4)') par_szz 
     1266      WRITE(str71,'("Size of zoom in z :",I4)') par_szz 
    12621267      WRITE(str72,'("Size declared for axis ",A," :",I4)') & 
    12631268 &     TRIM(zax_name(pfileid,pzid)),zax_size(pfileid,pzid) 
    1264       CALL ipslerr (3,"histdef", str70, str71, str72) 
     1269      CALL ipslerr (3,"histdef",str70,str71,str72) 
    12651270    ENDIF 
    12661271!- 
    … …  
    12701275      str70 = "The vertical size of variable "// & 
    12711276 &            "is smaller than that of the zoom." 
    1272       WRITE(str71,'("Declared vertical size of data :", I5)') pzsize 
     1277      WRITE(str71,'("Declared vertical size of data :",I5)') pzsize 
    12731278      WRITE(str72,'("Size of zoom for variable ",a," = ",I5)') & 
    12741279 &     TRIM(tmp_name),par_szz 
    1275       CALL ipslerr (3,"histdef", str70, str71, str72) 
     1280      CALL ipslerr (3,"histdef",str70,str71,str72) 
    12761281    ENDIF 
    12771282    var_zaxid(pfileid,iv) = pzid 
    … …  
    13141319  freq_wrt(pfileid,iv) = pfreq_wrt 
    13151320!- 
    1316   CALL ioget_calendar(un_an, un_jour) 
     1321  CALL ioget_calendar(un_an,un_jour) 
    13171322  IF (pfreq_opp < 0) THEN 
    13181323    CALL ioget_calendar(un_an) 
    … …  
    13361341    str72 = "PATCH : frequency set to deltat" 
    13371342!- 
    1338     CALL ipslerr (2,"histdef", str70, str71, str72) 
     1343    CALL ipslerr (2,"histdef",str70,str71,str72) 
    13391344!- 
    13401345    freq_opp(pfileid,iv) = deltat(pfileid) 
    … …  
    13471352    str72 = "PATCH : frequency set to deltat" 
    13481353!- 
    1349     CALL ipslerr (2,"histdef", str70, str71, str72) 
     1354    CALL ipslerr (2,"histdef",str70,str71,str72) 
    13501355!- 
    13511356    freq_wrt(pfileid,iv) = deltat(pfileid) 
    … …  
    13631368 &      TRIM(tmp_name) 
    13641369      str72 = "PATCH : The smalest frequency of both is used" 
    1365       CALL ipslerr (2,"histdef", str70, str71, str72) 
     1370      CALL ipslerr (2,"histdef",str70,str71,str72) 
    13661371      IF (test_fopp < test_fwrt) THEN 
    13671372        freq_opp(pfileid,iv) = pfreq_opp 
    … …  
    13801385 &     TRIM(tmp_name) 
    13811386      str72 = 'PATCH : The output frequency is used for both' 
    1382       CALL ipslerr (2,"histdef", str70, str71, str72) 
     1387      CALL ipslerr (2,"histdef",str70,str71,str72) 
    13831388      freq_opp(pfileid,iv) = pfreq_wrt 
    13841389    ENDIF 
    … …  
    13861391    WRITE (str70,'("Operation on variable ",a," is unknown")') & 
    13871392&    TRIM(tmp_name) 
    1388     WRITE (str71, '("operation requested is :",a)') tmp_topp 
    1389     WRITE (str72, '("File ID :",I3)') pfileid 
    1390     CALL ipslerr (3,"histdef", str70, str71, str72) 
     1393    WRITE (str71,'("operation requested is :",a)') tmp_topp 
     1394    WRITE (str72,'("File ID :",I3)') pfileid 
     1395    CALL ipslerr (3,"histdef",str70,str71,str72) 
    13911396  ENDIF 
    13921397!- 
    … …  
    14001405    IF (hist_calc_rng(pfileid,iv)) THEN 
    14011406      hist_minmax(pfileid,iv,1:2) = & 
    1402  &      (/ ABS(missing_val), -ABS(missing_val) /) 
     1407 &      (/ ABS(missing_val),-ABS(missing_val) /) 
    14031408    ELSE 
    14041409      hist_minmax(pfileid,iv,1:2) = var_range(1:2) 
    … …  
    14741479  IMPLICIT NONE 
    14751480!- 
    1476   INTEGER, INTENT(IN) :: pfileid 
    1477 !- 
    1478   INTEGER :: ncid, ncvarid 
    1479   INTEGER :: iret, ndim, iv, itx, ziv 
    1480   INTEGER :: itax 
    1481   INTEGER :: dims(4), dim_cnt 
    1482   INTEGER :: year, month, day, hours, minutes 
     1481  INTEGER,INTENT(IN) :: pfileid 
     1482!- 
     1483  INTEGER :: ncid,ncvarid,iret,ndim,iv,itx,ziv,itax,dim_cnt 
     1484  INTEGER,DIMENSION(4) :: dims 
     1485  INTEGER :: year,month,day,hours,minutes 
    14831486  REAL :: sec 
    14841487  REAL :: rtime0 
    1485   CHARACTER(LEN=20) :: tname, tunit 
    14861488  CHARACTER(LEN=30) :: str30 
    1487   CHARACTER(LEN=80) :: ttitle 
    14881489  CHARACTER(LEN=120) :: assoc 
    14891490  CHARACTER(LEN=70) :: str70 
    … …  
    15141515    iret = NF90_DEF_VAR (ncid,str30,NF90_FLOAT, & 
    15151516 &                       dims(1),tdimid(pfileid,itx)) 
    1516     iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'axis',"T") 
     1517    IF (nb_tax(pfileid) <= 1) THEN 
     1518      iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'axis',"T") 
     1519    ENDIF 
     1520    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'standard_name',"time") 
    15171521!--- 
    15181522!   To transform the current itau into a real date and take it 
    … …  
    15221526!   if there is a ioconf routine to control it. 
    15231527!--- 
    1524 !-- rtime0 = itau2date(itau0(pfileid), date0(pfileid), deltat(pfileid)) 
     1528!-- rtime0 = itau2date(itau0(pfileid),date0(pfileid),deltat(pfileid)) 
    15251529    rtime0 = date0(pfileid) 
    15261530!- 
    1527     CALL ju2ymds(rtime0, year, month, day, sec) 
     1531    CALL ju2ymds(rtime0,year,month,day,sec) 
    15281532!--- 
    15291533!   Catch any error induced by a change in calendar ! 
    … …  
    15661570    itax = var_axid(pfileid,iv) 
    15671571!--- 
    1568     tname = name(pfileid,iv) 
    1569     tunit = unit_name(pfileid,iv) 
    1570     ttitle = title(pfileid,iv) 
    1571 !--- 
    15721572    IF (regular(pfileid) ) THEN 
    1573       dims(1:2) = (/ xid(pfileid), yid(pfileid) /) 
     1573      dims(1:2) = (/ xid(pfileid),yid(pfileid) /) 
    15741574      dim_cnt = 2 
    15751575    ELSE 
    … …  
    15891589        IF (ziv == -99) THEN 
    15901590          ndim = dim_cnt+1 
    1591           dims(dim_cnt+1:dim_cnt+2) = (/ tid(pfileid), 0 /) 
     1591          dims(dim_cnt+1:dim_cnt+2) = (/ tid(pfileid),0 /) 
    15921592        ELSE 
    15931593          ndim = dim_cnt+2 
    1594           dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(pfileid,ziv), tid(pfileid) /) 
     1594          dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(pfileid,ziv),tid(pfileid) /) 
    15951595        ENDIF 
    15961596      ELSE 
    15971597        IF (ziv == -99) THEN 
    15981598          ndim = dim_cnt 
    1599           dims(dim_cnt+1:dim_cnt+2) = (/ 0, 0 /) 
     1599          dims(dim_cnt+1:dim_cnt+2) = (/ 0,0 /) 
    16001600        ELSE 
    16011601          ndim = dim_cnt+1 
    1602           dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(pfileid,ziv), 0 /) 
     1602          dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(pfileid,ziv),0 /) 
    16031603        ENDIF 
    16041604      ENDIF 
    16051605!- 
    1606       iret = NF90_DEF_VAR (ncid,TRIM(tname),NF90_FLOAT, & 
     1606      iret = NF90_DEF_VAR (ncid,TRIM(name(pfileid,iv)),NF90_FLOAT, & 
    16071607 &                         dims(1:ABS(ndim)),ncvarid) 
    16081608!- 
    16091609      ncvar_ids(pfileid,iv) = ncvarid 
    16101610!- 
    1611       IF (LEN_TRIM(tunit) > 0) THEN 
    1612         iret = NF90_PUT_ATT (ncid,ncvarid,'units',TRIM(tunit)) 
     1611      IF (LEN_TRIM(unit_name(pfileid,iv)) > 0) THEN 
     1612        iret = NF90_PUT_ATT (ncid,ncvarid,'units', & 
     1613 &                           TRIM(unit_name(pfileid,iv))) 
    16131614      ENDIF 
    16141615!- 
    1615       iret = NF90_PUT_ATT (ncid,ncvarid,'missing_value', & 
     1616      iret = NF90_PUT_ATT (ncid,ncvarid,'_Fillvalue', & 
    16161617 &                         REAL(missing_val,KIND=4)) 
    16171618      IF (hist_wrt_rng(pfileid,iv)) THEN 
    … …  
    16211622 &                           REAL(hist_minmax(pfileid,iv,2),KIND=4)) 
    16221623      ENDIF 
    1623 !- 
    1624       iret = NF90_PUT_ATT (ncid,ncvarid,'long_name',TRIM(ttitle)) 
    1625 !- 
    1626       iret = NF90_PUT_ATT (ncid,ncvarid,'short_name',TRIM(tname)) 
    1627 !- 
     1624      iret = NF90_PUT_ATT (ncid,ncvarid,'long_name', & 
     1625 &                         TRIM(title(pfileid,iv))) 
    16281626      iret = NF90_PUT_ATT (ncid,ncvarid,'online_operation', & 
    16291627 &                         TRIM(fullop(pfileid,iv))) 
    … …  
    16371635      END SELECT 
    16381636!- 
    1639       assoc='nav_lat nav_lon' 
    1640       ziv = var_zaxid(pfileid, iv) 
     1637      assoc=TRIM(hax_name(pfileid,var_haxid(pfileid,iv),2))  & 
     1638 &   //' '//TRIM(hax_name(pfileid,var_haxid(pfileid,iv),1)) 
     1639!- 
     1640      ziv = var_zaxid(pfileid,iv) 
    16411641      IF (ziv > 0) THEN 
    16421642        str30 = zax_name(pfileid,ziv) 
    … …  
    16541654        IF (check) THEN 
    16551655          WRITE(*,*) "histend : 2.0.n, freq_opp, freq_wrt", & 
    1656  &                   freq_opp(pfileid,iv), freq_wrt(pfileid,iv) 
     1656 &                   freq_opp(pfileid,iv),freq_wrt(pfileid,iv) 
    16571657        ENDIF 
    16581658!- 
    … …  
    16911691  IMPLICIT NONE 
    16921692!- 
    1693   INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex) 
     1693  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex 
     1694  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex 
    16941695  REAL,DIMENSION(:),INTENT(IN) :: pdata 
    16951696  CHARACTER(LEN=*),INTENT(IN) :: pvarname 
    1696 !- 
    1697   LOGICAL :: do_oper, do_write, largebuf 
    1698   INTEGER :: varid, io, nbpt_in, nbpt_out 
    1699   REAL, ALLOCATABLE,SAVE :: buff_tmp(:) 
     1697!--------------------------------------------------------------------- 
     1698  CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_1d=pdata) 
     1699!--------------------------- 
     1700END SUBROUTINE histwrite_r1d 
     1701!=== 
     1702SUBROUTINE histwrite_r2d (pfileid,pvarname,pitau,pdata,nbindex,nindex) 
     1703!--------------------------------------------------------------------- 
     1704  IMPLICIT NONE 
     1705!- 
     1706  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex 
     1707  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex 
     1708  REAL,DIMENSION(:,:),INTENT(IN) :: pdata 
     1709  CHARACTER(LEN=*),INTENT(IN) :: pvarname 
     1710!--------------------------------------------------------------------- 
     1711  CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_2d=pdata) 
     1712!--------------------------- 
     1713END SUBROUTINE histwrite_r2d 
     1714!=== 
     1715SUBROUTINE histwrite_r3d (pfileid,pvarname,pitau,pdata,nbindex,nindex) 
     1716!--------------------------------------------------------------------- 
     1717  IMPLICIT NONE 
     1718!- 
     1719  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex 
     1720  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex 
     1721  REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata 
     1722  CHARACTER(LEN=*),INTENT(IN) :: pvarname 
     1723!--------------------------------------------------------------------- 
     1724  CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_3d=pdata) 
     1725!--------------------------- 
     1726END SUBROUTINE histwrite_r3d 
     1727!=== 
     1728SUBROUTINE histw_rnd (pfileid,pvarname,pitau,nbindex,nindex, & 
     1729  &                   pdata_1d,pdata_2d,pdata_3d) 
     1730!--------------------------------------------------------------------- 
     1731  IMPLICIT NONE 
     1732!- 
     1733  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex 
     1734  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex 
     1735  CHARACTER(LEN=*),INTENT(IN) :: pvarname 
     1736  REAL,DIMENSION(:),INTENT(IN),OPTIONAL     :: pdata_1d 
     1737  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL   :: pdata_2d 
     1738  REAL,DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: pdata_3d 
     1739!- 
     1740  LOGICAL :: do_oper,do_write,largebuf,l1d,l2d,l3d 
     1741  INTEGER :: varid,io,nbpt_out 
     1742  INTEGER              :: nbpt_in1 
     1743  INTEGER,DIMENSION(2) :: nbpt_in2 
     1744  INTEGER,DIMENSION(3) :: nbpt_in3 
     1745  REAL,ALLOCATABLE,SAVE :: buff_tmp(:) 
    17001746  INTEGER,SAVE :: buff_tmp_sz 
    17011747  CHARACTER(LEN=7) :: tmp_opp 
     1748  CHARACTER(LEN=13) :: c_nam 
    17021749!- 
    17031750  LOGICAL :: check = .FALSE. 
    17041751!--------------------------------------------------------------------- 
     1752  l1d=PRESENT(pdata_1d); l2d=PRESENT(pdata_2d); l3d=PRESENT(pdata_3d); 
     1753  IF      (l1d) THEN 
     1754    c_nam = 'histwrite_r1d' 
     1755  ELSE IF (l2d) THEN 
     1756    c_nam = 'histwrite_r2d' 
     1757  ELSE IF (l3d) THEN 
     1758    c_nam = 'histwrite_r3d' 
     1759  ENDIF 
    17051760!- 
    17061761! 1.0 Try to catch errors like specifying the wrong file ID. 
    … …  
    17341789!- 
    17351790  CALL isittime & 
    1736  &  (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid,varid), & 
    1737  &   last_opp(pfileid,varid), last_opp_chk(pfileid,varid), do_oper) 
     1791 &  (pitau,date0(pfileid),deltat(pfileid),freq_opp(pfileid,varid), & 
     1792 &   last_opp(pfileid,varid),last_opp_chk(pfileid,varid),do_oper) 
    17381793!- 
    17391794! 4.0 We check if we need to write the data 
    … …  
    17461801!- 
    17471802  CALL isittime & 
    1748  &  (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid,varid), & 
    1749  &   last_wrt(pfileid,varid), last_wrt_chk(pfileid,varid), do_write) 
     1803 &  (pitau,date0(pfileid),deltat(pfileid),freq_wrt(pfileid,varid), & 
     1804 &   last_wrt(pfileid,varid),last_wrt_chk(pfileid,varid),do_write) 
    17501805!- 
    17511806! 5.0 histwrite called 
    … …  
    17601815!---- In the worst case we will do impossible operations 
    17611816!---- on part of the data ! 
    1762       datasz_in(pfileid,varid,1) = SIZE(pdata) 
    1763       datasz_in(pfileid,varid,2) = -1 
    1764       datasz_in(pfileid,varid,3) = -1 
     1817      datasz_in(pfileid,varid,1:3) = -1 
     1818      IF      (l1d) THEN 
     1819        datasz_in(pfileid,varid,1) = SIZE(pdata_1d) 
     1820      ELSE IF (l2d) THEN 
     1821        datasz_in(pfileid,varid,1) = SIZE(pdata_2d,DIM=1) 
     1822        datasz_in(pfileid,varid,2) = SIZE(pdata_2d,DIM=2) 
     1823      ELSE IF (l3d) THEN 
     1824        datasz_in(pfileid,varid,1) = SIZE(pdata_3d,DIM=1) 
     1825        datasz_in(pfileid,varid,2) = SIZE(pdata_3d,DIM=2) 
     1826        datasz_in(pfileid,varid,3) = SIZE(pdata_3d,DIM=3) 
     1827      ENDIF 
    17651828    ENDIF 
    17661829!- 
    … …  
    17801843 &       *scsize(pfileid,varid,3) 
    17811844      ELSE 
    1782         datasz_max(pfileid,varid) = & 
    1783  &        datasz_in(pfileid,varid,1) 
     1845        IF      (l1d) THEN 
     1846          datasz_max(pfileid,varid) = & 
     1847 &          datasz_in(pfileid,varid,1) 
     1848        ELSE IF (l2d) THEN 
     1849          datasz_max(pfileid,varid) = & 
     1850 &          datasz_in(pfileid,varid,1) & 
     1851 &         *datasz_in(pfileid,varid,2) 
     1852        ELSE IF (l3d) THEN 
     1853          datasz_max(pfileid,varid) = & 
     1854 &          datasz_in(pfileid,varid,1) & 
     1855 &         *datasz_in(pfileid,varid,2) & 
     1856 &         *datasz_in(pfileid,varid,3) 
     1857        ENDIF 
    17841858      ENDIF 
    17851859    ENDIF 
    … …  
    17881862      IF (check) THEN 
    17891863        WRITE(*,*) & 
    1790  &       "histwrite_r1d : allocate buff_tmp for buff_sz = ", & 
     1864 &       c_nam//" : allocate buff_tmp for buff_sz = ", & 
    17911865 &       datasz_max(pfileid,varid) 
    17921866      ENDIF 
    … …  
    17961870      IF (check) THEN 
    17971871        WRITE(*,*) & 
    1798  &       "histwrite_r1d : re-allocate buff_tmp for buff_sz = ", & 
     1872 &       c_nam//" : re-allocate buff_tmp for buff_sz = ", & 
    17991873 &       datasz_max(pfileid,varid) 
    18001874      ENDIF 
    … …  
    18081882!-- of the data at the same time. This should speed up things. 
    18091883!- 
    1810     nbpt_in = datasz_in(pfileid,varid,1) 
    18111884    nbpt_out = datasz_max(pfileid,varid) 
    1812     CALL mathop (sopps(pfileid,varid,1), nbpt_in, pdata, & 
    1813  &               missing_val, nbindex, nindex, & 
    1814  &               scal(pfileid,varid,1), nbpt_out, buff_tmp) 
    1815     CALL histwrite_real (pfileid, varid, pitau, nbpt_out, & 
    1816  &            buff_tmp, nbindex, nindex, do_oper, do_write) 
     1885    IF      (l1d) THEN 
     1886      nbpt_in1 = datasz_in(pfileid,varid,1) 
     1887      CALL mathop (sopps(pfileid,varid,1),nbpt_in1,pdata_1d, & 
     1888 &                 missing_val,nbindex,nindex, & 
     1889 &                 scal(pfileid,varid,1),nbpt_out,buff_tmp) 
     1890    ELSE IF (l2d) THEN 
     1891      nbpt_in2(1:2) = datasz_in(pfileid,varid,1:2) 
     1892      CALL mathop (sopps(pfileid,varid,1),nbpt_in2,pdata_2d, & 
     1893 &                 missing_val,nbindex,nindex, & 
     1894 &                 scal(pfileid,varid,1),nbpt_out,buff_tmp) 
     1895    ELSE IF (l3d) THEN 
     1896      nbpt_in3(1:3) = datasz_in(pfileid,varid,1:3) 
     1897      CALL mathop (sopps(pfileid,varid,1),nbpt_in3,pdata_3d, & 
     1898 &                 missing_val,nbindex,nindex, & 
     1899 &                 scal(pfileid,varid,1),nbpt_out,buff_tmp) 
     1900    ENDIF 
     1901    CALL histwrite_real (pfileid,varid,pitau,nbpt_out, & 
     1902 &            buff_tmp,nbindex,nindex,do_oper,do_write) 
    18171903  ENDIF 
    18181904!- 
    … …  
    18261912    last_wrt_chk(pfileid,varid) = -99 
    18271913  ENDIF 
    1828 !--------------------------- 
    1829 END SUBROUTINE histwrite_r1d 
    1830 !=== 
    1831 SUBROUTINE histwrite_r2d (pfileid,pvarname,pitau,pdata,nbindex,nindex) 
    1832 !--------------------------------------------------------------------- 
    1833   IMPLICIT NONE 
    1834 !- 
    1835   INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex) 
    1836   REAL,DIMENSION(:,:),INTENT(IN) :: pdata 
    1837   CHARACTER(LEN=*),INTENT(IN) :: pvarname 
    1838 !- 
    1839   LOGICAL :: do_oper, do_write, largebuf 
    1840   INTEGER :: varid, io, nbpt_in(1:2), nbpt_out 
    1841   REAL, ALLOCATABLE,SAVE :: buff_tmp(:) 
    1842   INTEGER,SAVE :: buff_tmp_sz 
    1843   CHARACTER(LEN=7) :: tmp_opp 
    1844 !- 
    1845   LOGICAL :: check = .FALSE. 
    1846 !--------------------------------------------------------------------- 
    1847 !- 
    1848 ! 1.0 Try to catch errors like specifying the wrong file ID. 
    1849 !     Thanks Marine for showing us what errors users can make ! 
    1850 !- 
    1851   IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN 
    1852     CALL ipslerr (3,"histwrite", & 
    1853  &    'Illegal file ID in the histwrite of variable',pvarname,' ') 
    1854   ENDIF 
    1855 !- 
    1856 ! 1.1 Find the id of the variable to be written and the real time 
    1857 !- 
    1858   CALL histvar_seq (pfileid,pvarname,varid) 
    1859 !- 
    1860 ! 2.0 do nothing for never operation 
    1861 !- 
    1862   tmp_opp = topp(pfileid,varid) 
    1863 !- 
    1864   IF (TRIM(tmp_opp) == "never") THEN 
    1865     last_opp_chk(pfileid,varid) = -99 
    1866     last_wrt_chk(pfileid,varid) = -99 
    1867   ENDIF 
    1868 !- 
    1869 ! 3.0 We check if we need to do an operation 
    1870 !- 
    1871   IF (last_opp_chk(pfileid,varid) == pitau) THEN 
    1872     CALL ipslerr (3,"histwrite", & 
    1873  &    'This variable as already been analysed at the present', & 
    1874  &    'time step',' ') 
    1875   ENDIF 
    1876 !- 
    1877   CALL isittime & 
    1878  &  (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid,varid), & 
    1879  &   last_opp(pfileid,varid), last_opp_chk(pfileid,varid), do_oper) 
    1880 !- 
    1881 ! 4.0 We check if we need to write the data 
    1882 !- 
    1883   IF (last_wrt_chk(pfileid,varid) == pitau) THEN 
    1884     CALL ipslerr (3,"histwrite", & 
    1885  &    'This variable as already been written for the present', & 
    1886  &    'time step',' ') 
    1887   ENDIF 
    1888 !- 
    1889   CALL isittime & 
    1890  &  (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid,varid), & 
    1891  &   last_wrt(pfileid,varid), last_wrt_chk(pfileid,varid), do_write) 
    1892 !- 
    1893 ! 5.0 histwrite called 
    1894 !- 
    1895   IF (do_oper.OR.do_write) THEN 
    1896 !- 
    1897 !-- 5.1 Get the sizes of the data we will handle 
    1898 !- 
    1899     IF (datasz_in(pfileid,varid,1) <= 0) THEN 
    1900 !---- There is the risk here that the user has over-sized the array. 
    1901 !---- But how can we catch this ? 
    1902 !---- In the worst case we will do impossible operations 
    1903 !---- on part of the data ! 
    1904       datasz_in(pfileid,varid,1) = SIZE(pdata, DIM=1) 
    1905       datasz_in(pfileid,varid,2) = SIZE(pdata, DIM=2) 
    1906       datasz_in(pfileid,varid,3) = -1 
    1907     ENDIF 
    1908 !- 
    1909 !-- 5.2 The maximum size of the data will give the size of the buffer 
    1910 !- 
    1911     IF (datasz_max(pfileid,varid) <= 0) THEN 
    1912       largebuf = .FALSE. 
    1913       DO io=1,nbopp(pfileid,varid) 
    1914         IF (INDEX(fuchnbout,sopps(pfileid,varid,io)) > 0) THEN 
    1915           largebuf = .TRUE. 
    1916         ENDIF 
    1917       ENDDO 
    1918       IF (largebuf) THEN 
    1919         datasz_max(pfileid,varid) = & 
    1920  &        scsize(pfileid,varid,1) & 
    1921  &       *scsize(pfileid,varid,2) & 
    1922  &       *scsize(pfileid,varid,3) 
    1923       ELSE 
    1924         datasz_max(pfileid,varid) = & 
    1925  &        datasz_in(pfileid,varid,1) & 
    1926  &       *datasz_in(pfileid,varid,2) 
    1927       ENDIF 
    1928     ENDIF 
    1929 !- 
    1930     IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1931       IF (check) THEN 
    1932         WRITE(*,*) & 
    1933  &       "histwrite_r2d : allocate buff_tmp for buff_sz = ", & 
    1934  &       datasz_max(pfileid,varid) 
    1935       ENDIF 
    1936       ALLOCATE (buff_tmp(datasz_max(pfileid,varid))) 
    1937       buff_tmp_sz = datasz_max(pfileid,varid) 
    1938     ELSE IF (datasz_max(pfileid,varid) > buff_tmp_sz) THEN 
    1939       IF (check) THEN 
    1940         WRITE(*,*) & 
    1941  &       "histwrite_r2d : re-allocate buff_tmp for buff_sz = ", & 
    1942  &       datasz_max(pfileid,varid) 
    1943       ENDIF 
    1944       DEALLOCATE (buff_tmp) 
    1945       ALLOCATE (buff_tmp(datasz_max(pfileid,varid))) 
    1946       buff_tmp_sz = datasz_max(pfileid,varid) 
    1947     ENDIF 
    1948 !- 
    1949 !-- We have to do the first operation anyway. 
    1950 !-- Thus we do it here and change the ranke 
    1951 !-- of the data at the same time. This should speed up things. 
    1952 !- 
    1953     nbpt_in(1:2) = datasz_in(pfileid,varid,1:2) 
    1954     nbpt_out = datasz_max(pfileid,varid) 
    1955     CALL mathop (sopps(pfileid,varid,1), nbpt_in, pdata, & 
    1956  &               missing_val, nbindex, nindex, & 
    1957  &               scal(pfileid,varid,1), nbpt_out, buff_tmp) 
    1958     CALL histwrite_real (pfileid, varid, pitau, nbpt_out, & 
    1959  &            buff_tmp, nbindex, nindex, do_oper, do_write) 
    1960   ENDIF 
    1961 !- 
    1962 ! 6.0 Manage time steps 
    1963 !- 
    1964   IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN 
    1965     last_opp_chk(pfileid,varid) = pitau 
    1966     last_wrt_chk(pfileid,varid) = pitau 
    1967   ELSE 
    1968     last_opp_chk(pfileid,varid) = -99 
    1969     last_wrt_chk(pfileid,varid) = -99 
    1970   ENDIF 
    1971 !--------------------------- 
    1972 END SUBROUTINE histwrite_r2d 
    1973 !=== 
    1974 SUBROUTINE histwrite_r3d (pfileid,pvarname,pitau,pdata,nbindex,nindex) 
    1975 !--------------------------------------------------------------------- 
    1976   IMPLICIT NONE 
    1977 !- 
    1978   INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex) 
    1979   REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata 
    1980   CHARACTER(LEN=*),INTENT(IN) :: pvarname 
    1981 !- 
    1982   LOGICAL :: do_oper, do_write, largebuf 
    1983   INTEGER :: varid, io, nbpt_in(1:3), nbpt_out 
    1984   REAL, ALLOCATABLE,SAVE :: buff_tmp(:) 
    1985   INTEGER,SAVE :: buff_tmp_sz 
    1986   CHARACTER(LEN=7) :: tmp_opp 
    1987 !- 
    1988   LOGICAL :: check = .FALSE. 
    1989 !--------------------------------------------------------------------- 
    1990 !- 
    1991 ! 1.0 Try to catch errors like specifying the wrong file ID. 
    1992 !     Thanks Marine for showing us what errors users can make ! 
    1993 !- 
    1994   IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN 
    1995     CALL ipslerr (3,"histwrite", & 
    1996  &    'Illegal file ID in the histwrite of variable',pvarname,' ') 
    1997   ENDIF 
    1998 !- 
    1999 ! 1.1 Find the id of the variable to be written and the real time 
    2000 !- 
    2001   CALL histvar_seq (pfileid,pvarname,varid) 
    2002 !- 
    2003 ! 2.0 do nothing for never operation 
    2004 !- 
    2005   tmp_opp = topp(pfileid,varid) 
    2006 !- 
    2007   IF (TRIM(tmp_opp) == "never") THEN 
    2008     last_opp_chk(pfileid,varid) = -99 
    2009     last_wrt_chk(pfileid,varid) = -99 
    2010   ENDIF 
    2011 !- 
    2012 ! 3.0 We check if we need to do an operation 
    2013 !- 
    2014   IF (last_opp_chk(pfileid,varid) == pitau) THEN 
    2015     CALL ipslerr (3,"histwrite", & 
    2016  &    'This variable as already been analysed at the present', & 
    2017  &    'time step',' ') 
    2018   ENDIF 
    2019 !- 
    2020   CALL isittime & 
    2021  &  (pitau, date0(pfileid), deltat(pfileid), freq_opp(pfileid,varid), & 
    2022  &   last_opp(pfileid,varid), last_opp_chk(pfileid,varid), do_oper) 
    2023 !- 
    2024 ! 4.0 We check if we need to write the data 
    2025 !- 
    2026   IF (last_wrt_chk(pfileid,varid) == pitau) THEN 
    2027     CALL ipslerr (3,"histwrite", & 
    2028  &    'This variable as already been written for the present', & 
    2029  &    'time step',' ') 
    2030   ENDIF 
    2031 !- 
    2032   CALL isittime & 
    2033  &  (pitau, date0(pfileid), deltat(pfileid), freq_wrt(pfileid,varid), & 
    2034  &   last_wrt(pfileid,varid), last_wrt_chk(pfileid,varid), do_write) 
    2035 !- 
    2036 ! 5.0 histwrite called 
    2037 !- 
    2038   IF (do_oper.OR.do_write) THEN 
    2039 !- 
    2040 !-- 5.1 Get the sizes of the data we will handle 
    2041 !- 
    2042     IF (datasz_in(pfileid,varid,1) <= 0) THEN 
    2043 !---- There is the risk here that the user has over-sized the array. 
    2044 !---- But how can we catch this ? 
    2045 !---- In the worst case we will do impossible operations 
    2046 !---- on part of the data ! 
    2047       datasz_in(pfileid,varid,1) = SIZE(pdata, DIM=1) 
    2048       datasz_in(pfileid,varid,2) = SIZE(pdata, DIM=2) 
    2049       datasz_in(pfileid,varid,3) = SIZE(pdata, DIM=3) 
    2050     ENDIF 
    2051 !- 
    2052 !-- 5.2 The maximum size of the data will give the size of the buffer 
    2053 !- 
    2054     IF (datasz_max(pfileid,varid) <= 0) THEN 
    2055       largebuf = .FALSE. 
    2056       DO io =1,nbopp(pfileid,varid) 
    2057         IF (INDEX(fuchnbout,sopps(pfileid,varid,io)) > 0) THEN 
    2058           largebuf = .TRUE. 
    2059         ENDIF 
    2060       ENDDO 
    2061       IF (largebuf) THEN 
    2062         datasz_max(pfileid,varid) = & 
    2063  &        scsize(pfileid,varid,1) & 
    2064  &       *scsize(pfileid,varid,2) & 
    2065  &       *scsize(pfileid,varid,3) 
    2066       ELSE 
    2067         datasz_max(pfileid,varid) = & 
    2068  &        datasz_in(pfileid,varid,1) & 
    2069  &       *datasz_in(pfileid,varid,2) & 
    2070  &       *datasz_in(pfileid,varid,3) 
    2071       ENDIF 
    2072     ENDIF 
    2073 !- 
    2074     IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    2075       IF (check) THEN 
    2076         WRITE(*,*) & 
    2077  &       "histwrite_r1d : allocate buff_tmp for buff_sz = ", & 
    2078  &       datasz_max(pfileid,varid) 
    2079       ENDIF 
    2080       ALLOCATE (buff_tmp(datasz_max(pfileid,varid))) 
    2081       buff_tmp_sz = datasz_max(pfileid,varid) 
    2082     ELSE IF (datasz_max(pfileid,varid) > buff_tmp_sz) THEN 
    2083       IF (check) THEN 
    2084         WRITE(*,*) & 
    2085  &       "histwrite_r1d : re-allocate buff_tmp for buff_sz = ", & 
    2086  &       datasz_max(pfileid,varid) 
    2087       ENDIF 
    2088       DEALLOCATE (buff_tmp) 
    2089       ALLOCATE (buff_tmp(datasz_max(pfileid,varid))) 
    2090       buff_tmp_sz = datasz_max(pfileid,varid) 
    2091     ENDIF 
    2092 !- 
    2093 !-- We have to do the first operation anyway. 
    2094 !-- Thus we do it here and change the ranke 
    2095 !-- of the data at the same time. This should speed up things. 
    2096 !- 
    2097     nbpt_in(1:3) = datasz_in(pfileid,varid,1:3) 
    2098     nbpt_out = datasz_max(pfileid,varid) 
    2099     CALL mathop (sopps(pfileid,varid,1), nbpt_in, pdata, & 
    2100  &               missing_val, nbindex, nindex, & 
    2101  &               scal(pfileid,varid,1), nbpt_out, buff_tmp) 
    2102     CALL histwrite_real (pfileid, varid, pitau, nbpt_out, & 
    2103  &            buff_tmp, nbindex, nindex, do_oper, do_write) 
    2104   ENDIF 
    2105 !- 
    2106 ! 6.0 Manage time steps 
    2107 !- 
    2108   IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN 
    2109     last_opp_chk(pfileid,varid) = pitau 
    2110     last_wrt_chk(pfileid,varid) = pitau 
    2111   ELSE 
    2112     last_opp_chk(pfileid,varid) = -99 
    2113     last_wrt_chk(pfileid,varid) = -99 
    2114   ENDIF 
    2115 !--------------------------- 
    2116 END SUBROUTINE histwrite_r3d 
     1914!----------------------- 
     1915END SUBROUTINE histw_rnd 
    21171916!=== 
    21181917SUBROUTINE histwrite_real & 
    … …  
    21301929  LOGICAL,INTENT(IN) :: do_oper,do_write 
    21311930!- 
    2132   INTEGER :: tsz, ncid, ncvarid 
    2133   INTEGER :: i, iret, ipt, itax 
    2134   INTEGER :: io, nbin, nbout 
    2135   INTEGER,DIMENSION(4) :: corner, edges 
     1931  INTEGER :: tsz,ncid,ncvarid,i,iret,ipt,itax,io,nbin,nbout 
     1932  INTEGER,DIMENSION(4) :: corner,edges 
    21361933  INTEGER :: itime 
    21371934!- 
    … …  
    21461943!--------------------------------------------------------------------- 
    21471944  IF (check) THEN 
    2148     WRITE(*,*) "histwrite 0.0 :  VAR : ", name(pfileid,varid) 
    2149     WRITE(*,*) "histwrite 0.0 : nbindex, nindex :", & 
     1945    WRITE(*,*) "histwrite 0.0 :  VAR : ",name(pfileid,varid) 
     1946    WRITE(*,*) "histwrite 0.0 : nbindex,nindex :", & 
    21501947    &  nbindex,nindex(1:MIN(3,nbindex)),'...',nindex(MAX(1,nbindex-3):nbindex) 
    21511948  ENDIF 
    … …  
    22082005! 3.0 Do the operations or transfer the slab of data into buff_tmp 
    22092006!- 
    2210   IF (check) WRITE(*,*) "histwrite: 3.0", pfileid 
     2007  IF (check) WRITE(*,*) "histwrite: 3.0",pfileid 
    22112008!- 
    22122009! 3.1 DO the Operations only if needed 
    … …  
    22192016!--     we started in the interface routine 
    22202017!- 
    2221     DO io = 2, nbopp(i,varid),2 
     2018    DO io = 2,nbopp(i,varid),2 
    22222019      nbin = nbout 
    22232020      nbout = datasz_max(i,varid) 
    … …  
    22592056 &       zorig(i,varid,3),zsize(i,varid,3), & 
    22602057 &       scsize(i,varid,1),scsize(i,varid,2),scsize(i,varid,3), & 
    2261  &       buff_tmp, buff_tmp2_sz,buff_tmp2) 
     2058 &       buff_tmp,buff_tmp2_sz,buff_tmp2) 
    22622059!- 
    22632060!-- 4.0 Get the min and max of the field (buff_tmp) 
    … …  
    22782075!--     output we do not transfer to the buffer. 
    22792076!- 
    2280     IF (check) WRITE(*,*) "histwrite: 5.0", pfileid, "tsz :", tsz 
     2077    IF (check) WRITE(*,*) "histwrite: 5.0",pfileid,"tsz :",tsz 
    22812078!- 
    22822079    ipt = point(pfileid,varid) 
    22832080!- 
    2284 !   WRITE(*,*) 'OPE ipt, buffer :', pvarname, ipt, varid 
     2081!   WRITE(*,*) 'OPE ipt, buffer :',pvarname,ipt,varid 
    22852082!- 
    22862083    IF (     (TRIM(tmp_opp) /= "inst") & 
    … …  
    22972094! 6.0 Write to file if needed 
    22982095!- 
    2299   IF (check) WRITE(*,*) "histwrite: 6.0", pfileid 
     2096  IF (check) WRITE(*,*) "histwrite: 6.0",pfileid 
    23002097!- 
    23012098  IF (do_write) THEN 
    … …  
    23062103!-- 6.1 Do the operations that are needed before writting 
    23072104!- 
    2308     IF (check) WRITE(*,*) "histwrite: 6.1", pfileid 
     2105    IF (check) WRITE(*,*) "histwrite: 6.1",pfileid 
    23092106!- 
    23102107    IF (     (TRIM(tmp_opp) /= "inst") & 
    … …  
    23192116   &    .AND.(TRIM(tmp_opp) /= "once") ) THEN 
    23202117!- 
    2321       IF (check) WRITE(*,*) "histwrite: 6.2", pfileid 
     2118      IF (check) WRITE(*,*) "histwrite: 6.2",pfileid 
    23222119!- 
    23232120      itax = var_axid(pfileid,varid) 
    23242121      itime = nb_wrt(pfileid,varid)+1 
    23252122!- 
    2326       IF (tax_last(pfileid, itax) < itime) THEN 
     2123      IF (tax_last(pfileid,itax) < itime) THEN 
    23272124        iret = NF90_PUT_VAR (ncid,tdimid(pfileid,itax),(/ rtime /), & 
    23282125 &                            start=(/ itime /),count=(/ 1 /)) 
    2329         tax_last(pfileid, itax) = itime 
     2126        tax_last(pfileid,itax) = itime 
    23302127      ENDIF 
    23312128    ELSE 
    … …  
    23422139    IF (scsize(pfileid,varid,3) == 1) THEN 
    23432140      IF (regular(pfileid)) THEN 
    2344         corner(1:4) = (/ 1, 1, itime, 0 /) 
     2141        corner(1:4) = (/ 1,1,itime,0 /) 
    23452142        edges(1:4) = (/ zsize(pfileid,varid,1), & 
    2346  &                      zsize(pfileid,varid,2), & 
    2347  &                       1, 0 /) 
     2143 &                      zsize(pfileid,varid,2),1,0 /) 
    23482144      ELSE 
    2349         corner(1:4) = (/ 1, itime, 0, 0 /) 
    2350         edges(1:4) = (/ zsize(pfileid,varid,1), 1, 0, 0 /) 
     2145        corner(1:4) = (/ 1,itime,0,0 /) 
     2146        edges(1:4) = (/ zsize(pfileid,varid,1),1,0,0 /) 
    23512147      ENDIF 
    23522148    ELSE 
    23532149      IF (regular(pfileid)) THEN 
    2354         corner(1:4) = (/ 1, 1, 1, itime /) 
     2150        corner(1:4) = (/ 1,1,1,itime /) 
    23552151        edges(1:4) = (/ zsize(pfileid,varid,1), & 
    23562152 &                      zsize(pfileid,varid,2), & 
    2357  &                      zsize(pfileid,varid,3), 1 /) 
     2153 &                      zsize(pfileid,varid,3),1 /) 
    23582154      ELSE 
    2359         corner(1:4) = (/ 1, 1, itime, 0 /) 
     2155        corner(1:4) = (/ 1,1,itime,0 /) 
    23602156        edges(1:4) = (/ zsize(pfileid,varid,1), & 
    2361  &                      zsize(pfileid,varid,3), 1, 0 /) 
     2157 &                      zsize(pfileid,varid,3),1,0 /) 
    23622158      ENDIF 
    23632159    ENDIF 
    … …  
    24772273!------ from the initialisation of the model. 
    24782274!- 
    2479         DO ib = 0, sp-overlap(pfid)*2 
     2275        DO ib = 0,sp-overlap(pfid)*2 
    24802276          IF ( learning(pfid) .AND.& 
    24812277            & SUM(ABS(varseq(pfid,ib+1:ib+overlap(pfid)) -& 
    … …  
    25542350  LOGICAL :: check = .FALSE. 
    25552351!--------------------------------------------------------------------- 
    2556   IF (check) WRITE(*,*) 'Entering loop on files :', nb_files 
     2352  IF (check) WRITE(*,*) 'Entering loop on files :',nb_files 
    25572353!- 
    25582354! 1.The loop on files to synchronise 
    … …  
    25682364    IF (file_exists) THEN 
    25692365      IF (check) THEN 
    2570         WRITE(*,*) 'Synchronising specified file number :', file 
     2366        WRITE(*,*) 'Synchronising specified file number :',file 
    25712367      ENDIF 
    25722368      ncid = ncdf_ids(ifile) 
    … …  
    25962392  LOGICAL :: check=.FALSE. 
    25972393!--------------------------------------------------------------------- 
    2598   IF (check) WRITE(*,*) 'Entering loop on files :', nb_files 
     2394  IF (check) WRITE(*,*) 'Entering loop on files :',nb_files 
    25992395!- 
    26002396  IF (PRESENT(fid)) THEN 
    … …  
    26072403!- 
    26082404  DO ifile=start_loop,end_loop 
    2609     IF (check) WRITE(*,*) 'Closing specified file number :', ifile 
     2405    IF (check) WRITE(*,*) 'Closing specified file number :',ifile 
    26102406    ncid = ncdf_ids(ifile) 
    26112407    iret = NF90_REDEF (ncid) 
    … …  
    26132409!-- 1. Loop on the number of variables to add some final information 
    26142410!--- 
    2615     IF (check) WRITE(*,*) 'Entering loop on vars :', nb_var(ifile) 
     2411    IF (check) WRITE(*,*) 'Entering loop on vars : ',nb_var(ifile) 
    26162412    DO iv=1,nb_var(ifile) 
    26172413      IF (hist_wrt_rng(ifile,iv)) THEN 
Note: See TracChangeset for help on using the changeset viewer.