Changeset 259 for IOIPSL


Ignore:
Timestamp:
02/21/08 14:50:41 (16 years ago)
Author:
bellier
Message:

JB : a GREAT cleaning !

File:
1 edited

Legend:

Unmodified
Added
Removed
  • IOIPSL/trunk/src/restcom.f90

    r236 r259  
    66!- 
    77USE errioipsl, ONLY : ipslerr 
    8 USE stringop  
     8USE stringop 
    99USE calendar 
    1010USE mathelp 
     
    2020 &  ioget_expval, ioget_vdim 
    2121!- 
    22 INTERFACE restput  
     22INTERFACE restput 
    2323  MODULE PROCEDURE & 
    2424 &  restput_r3d, restput_r2d, restput_r1d, & 
     
    2828INTERFACE restget 
    2929  MODULE PROCEDURE & 
    30  &  restget_r3d, restget_r2d, restget_r1d, & 
    31  &  restget_opp_r2d, restget_opp_r1d 
     30 &  restget_r3d,restget_r2d,restget_r1d, & 
     31 &  restget_opp_r2d,restget_opp_r1d 
    3232END INTERFACE 
    3333!- 
    3434! We do not use allocatable arrays because these sizes are safe 
    35 ! and we do not know from start how many variables will be in  
     35! and we do not know from start how many variables will be in 
    3636! the out file. 
    3737!- 
     
    4242!- 
    4343! The IDs of the netCDF files are going in pairs. 
    44 ! The input one (netcdf_id(?,1)) and the output one (netcdf_id(?,2))  
    45 !- 
    46   INTEGER,SAVE :: nbfiles = 0  
     44! The input one (netcdf_id(?,1)) and the output one (netcdf_id(?,2)) 
     45!- 
     46  INTEGER,SAVE :: nb_fi = 0 
    4747  INTEGER,DIMENSION(max_file,2),SAVE :: netcdf_id = -1 
    4848!- 
     
    8181!   ?ax_infs (if,in,1) = size of axis 
    8282!   ?ax_infs (if,in,2) = id of dimension 
    83 ! Number of x,y and z axes in the output file :  
     83! Number of x,y and z axes in the output file : 
    8484!   ?ax_nb(if) 
    8585!- 
     
    139139  LOGICAL,SAVE :: lock_valexp = .FALSE. 
    140140!- 
    141 !- Temporary variables in which we store the attributed 
    142 !- which are going to be given to 
    143 !- a new variable which is going to be defined. 
     141! Temporary variables in which we store the attributed which are going 
     142! to be given to a new variable which is going to be defined. 
    144143!- 
    145144  CHARACTER(LEN=80),SAVE :: rest_units='XXXXX',rest_lname='XXXXX' 
    146145!- 
    147 !=== 
    148 !- 
     146! For allocations 
     147!- 
     148  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp1,buff_tmp2 
     149!- 
     150!=== 
    149151CONTAINS 
     152!=== 
    150153!- 
    151154SUBROUTINE restini & 
     
    154157!--------------------------------------------------------------------- 
    155158!- This subroutine sets up all the restart process. 
    156 !- It will call the subroutine which opens the input  
     159!- It will call the subroutine which opens the input 
    157160!- and output files. 
    158161!- The time step (itau), date of origine (date0) and time step are 
     
    181184!- llm      : Dimension in the vertical 
    182185!- lev      : Positions of the levels 
    183 !- fnameout :  
     186!- fnameout : 
    184187!- 
    185188!- OUTPUT 
     
    194197!- 
    195198!- owrite_time_in : logical  argument which allows to 
    196 !-                  overwrite the time in the restart file  
     199!-                  overwrite the time in the restart file 
    197200!- domain_id      : Domain identifier 
    198201!--------------------------------------------------------------------- 
     
    210213  INTEGER :: ncfid 
    211214  REAL :: dt_tmp,date0_tmp 
    212   INTEGER,ALLOCATABLE :: tmp_index(:,:) 
    213   REAL,ALLOCATABLE :: tmp_julian(:,:) 
    214215  LOGICAL :: l_fi,l_fo,l_rw 
    215216  LOGICAL :: overwrite_time 
     
    230231  ENDIF 
    231232!- 
    232   nbfiles = nbfiles+1 
    233 !- 
    234   IF (nbfiles > max_file) THEN 
     233  nb_fi = nb_fi+1 
     234!- 
     235  IF (nb_fi > max_file) THEN 
    235236    CALL ipslerr (3,'restini',& 
    236237 &   'Too many restart files are used. The problem can be',& 
     
    254255  ENDIF 
    255256!- 
    256 ! 1.0 Open the input file.   
     257! 1.0 Open the input file. 
    257258!- 
    258259  IF (l_fi) THEN 
    259260!--- 
    260     IF (check) WRITE(*,*) 'restini 1.0 : Open input file'  
     261    IF (check) WRITE(*,*) 'restini 1.0 : Open input file' 
    261262!-- Add DOMAIN number and ".nc" suffix in file names if needed 
    262263    fname = fnamein 
    263264    CALL flio_dom_file (fname,domain_id) 
    264265!-- Open the file 
    265     CALL restopenin & 
    266       (nbfiles,fname,l_rw,iim,jjm, & 
    267        lon,lat,llm,lev,ncfid) 
    268     netcdf_id(nbfiles,1) = ncfid 
     266    CALL restopenin (nb_fi,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid) 
     267    netcdf_id(nb_fi,1) = ncfid 
    269268!--- 
    270269!-- 1.3 Extract the time information 
    271270!--- 
    272     CALL restsett (nbfiles,dt_tmp,date0_tmp) 
     271    CALL restsett (dt_tmp,date0_tmp,itau,overwrite_time) 
    273272    IF (.NOT.overwrite_time) THEN 
    274273      dt = dt_tmp 
     
    279278!--- 
    280279!-- 2.0 The case of a missing restart file is dealt with 
    281 !---          
     280!--- 
    282281    IF (check) WRITE(*,*) 'restini 2.0' 
    283282!--- 
     
    306305!-- 2.2 Allocate the time axes and write the inputed variables 
    307306!--- 
    308     tax_size_in(nbfiles) = 1 
    309     IF ( .NOT.ALLOCATED(t_index) .AND. .NOT.ALLOCATED(t_julian) ) THEN 
    310       IF (check) THEN 
    311         WRITE(*,*) 'restini : Allocate times axes at :', & 
    312                    max_file,tax_size_in(nbfiles) 
    313       ENDIF 
    314       ALLOCATE(t_index(max_file,tax_size_in(nbfiles))) 
    315       t_index (:,:) = 0 
    316       ALLOCATE(t_julian(max_file,tax_size_in(nbfiles))) 
    317       t_julian (:,:) = 0.0 
    318     ELSE 
    319       IF (    (SIZE(t_index,DIM=2)  < tax_size_in(nbfiles)) & 
    320           .OR.(SIZE(t_julian,DIM=2) < tax_size_in(nbfiles)) ) THEN 
    321         IF (check) THEN 
    322           WRITE(*,*) 'restini : Reallocate times axes at :', & 
    323                      max_file,tax_size_in(nbfiles) 
    324         ENDIF 
    325         ALLOCATE(tmp_index(max_file,tax_size_in(nbfiles))) 
    326         ALLOCATE(tmp_julian(max_file,tax_size_in(nbfiles))) 
    327         tmp_index(:,:) = t_index(:,:) 
    328         tmp_julian(:,:) = t_julian(:,:) 
    329         DEALLOCATE(t_index) 
    330         DEALLOCATE(t_julian) 
    331         ALLOCATE(t_index(max_file,tax_size_in(nbfiles))) 
    332         ALLOCATE(t_julian(max_file,tax_size_in(nbfiles))) 
    333         t_index(:,:) = tmp_index(:,:) 
    334         t_julian(:,:) = tmp_julian(:,:) 
    335       ENDIF 
    336     ENDIF 
    337 !--- 
    338     t_index(nbfiles,1) = itau 
    339     t_julian(nbfiles,1) = date0 
    340 !--- 
     307    tax_size_in(nb_fi) = 1 
     308    CALL rest_atim (check,'restini') 
     309    t_index(nb_fi,1) = itau 
     310    t_julian(nb_fi,1) = date0 
    341311  ENDIF 
    342312!- 
     
    347317!-- Open the file 
    348318    CALL restopenout & 
    349       (nbfiles,fname,iim,jjm, & 
    350        lon,lat,llm,lev,dt,date0,ncfid,domain_id) 
    351     netcdf_id(nbfiles,2) = ncfid 
     319      (nb_fi,fname,iim,jjm,lon,lat,llm,lev,dt,date0,ncfid,domain_id) 
     320    netcdf_id(nb_fi,2) = ncfid 
    352321  ELSE IF (l_fi.AND.l_fo) THEN 
    353     netcdf_id(nbfiles,2) = netcdf_id(nbfiles,1) 
    354     varname_out(nbfiles,:) = varname_in(nbfiles,:)  
    355     nbvar_out(nbfiles) = nbvar_in(nbfiles)  
    356     tind_varid_out(nbfiles) = tind_varid_in(nbfiles)  
    357     tax_varid_out(nbfiles) = tax_varid_in(nbfiles)  
    358     varid_out(nbfiles,:) = varid_in(nbfiles,:)  
    359     touched_out(nbfiles,:) = .TRUE. 
     322    netcdf_id(nb_fi,2) = netcdf_id(nb_fi,1) 
     323    varname_out(nb_fi,:) = varname_in(nb_fi,:) 
     324    nbvar_out(nb_fi) = nbvar_in(nb_fi) 
     325    tind_varid_out(nb_fi) = tind_varid_in(nb_fi) 
     326    tax_varid_out(nb_fi) = tax_varid_in(nb_fi) 
     327    varid_out(nb_fi,:) = varid_in(nb_fi,:) 
     328    touched_out(nb_fi,:) = .TRUE. 
    360329  ENDIF 
    361330!- 
     
    372341  IF (INDEX(calend_str,'unknown') < 1) THEN 
    373342    CALL ioconf_calendar (calend_str) 
    374   ENDIF 
    375 !- 
    376   IF (check) WRITE(*,*) 'After possible calendar configuration' 
     343    IF (check) THEN 
     344      WRITE(*,*) 'restini 2.3b : new calendar : ',calend_str 
     345    ENDIF 
     346  ENDIF 
    377347!- 
    378348! Save some data in the module 
    379349!- 
    380   deltat(nbfiles) = dt 
     350  deltat(nb_fi) = dt 
    381351!- 
    382352! Prepare the variables which will be returned 
    383353!- 
    384   fid = nbfiles 
     354  fid = nb_fi 
    385355  IF (check) THEN 
    386356    WRITE(*,*) 'SIZE of t_index :',SIZE(t_index), & 
    387357               SIZE(t_index,dim=1),SIZE(t_index,dim=2) 
     358    WRITE(*,*) 't_index = ',t_index(fid,:) 
    388359  ENDIF 
    389360  itau = t_index(fid,1) 
    390361!- 
    391   IF (check) WRITE(*,*) 'restini END'  
     362  IF (check) WRITE(*,*) 'restini END' 
    392363!--------------------- 
    393364END SUBROUTINE restini 
    394 !- 
    395 !=== 
    396 !- 
     365!=== 
    397366SUBROUTINE restopenin & 
    398367  (fid,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid) 
     
    415384! LOCAL 
    416385!- 
    417   INTEGER :: var_dims(max_dim),dimlen(max_dim) 
     386  INTEGER,DIMENSION(max_dim) :: var_dims,dimlen 
    418387  INTEGER :: nb_dim,nb_var,id_unl,id,iv 
    419   INTEGER :: iread,jread,lread,iret,idi 
     388  INTEGER :: iread,jread,lread,iret 
    420389  INTEGER :: lon_vid,lat_vid 
    421390  REAL :: lon_read(iim,jjm),lat_read(iim,jjm) 
    422391  REAL :: lev_read(llm) 
    423392  REAL :: mdlon,mdlat 
    424   CHARACTER(LEN=80) :: units,dimname 
     393  CHARACTER(LEN=80) :: units 
     394  CHARACTER(LEN=NF90_max_name),DIMENSION(max_dim) :: dimname 
    425395  LOGICAL :: check = .FALSE. 
    426396!--------------------------------------------------------------------- 
     
    444414      & 'More dimensions present in file that can be store',& 
    445415      & 'Please increase max_dim in the global variables ',& 
    446       & ' in restcom.F90') 
     416      & 'in restcom.F90') 
    447417  ENDIF 
    448418  IF (nb_var > max_var) THEN 
     
    455425  nbvar_in(fid) = nb_var 
    456426  nbdim_in(fid) = nb_dim 
    457   DO idi=1,nb_dim 
    458     iret = NF90_INQUIRE_DIMENSION(ncfid,idi,len=dimlen(idi)) 
     427  iread = -1; jread = -1; lread = -1; 
     428  DO id=1,nb_dim 
     429    iret = NF90_INQUIRE_DIMENSION(ncfid,id, & 
     430 &           len=dimlen(id),name=dimname(id)) 
     431    IF (check) THEN 
     432      WRITE (*,*) "restopenin 0.0 dimname",id,TRIM(dimname(id)) 
     433    ENDIF 
     434    IF      (TRIM(dimname(id)) == 'x') THEN 
     435      iread = dimlen(id) 
     436      IF (check) WRITE (*,*) "iread",iread 
     437    ELSE IF (TRIM(dimname(id)) == 'y') THEN 
     438      jread = dimlen(id) 
     439      IF (check) WRITE (*,*) "jread",jread 
     440    ELSE IF (TRIM(dimname(id)) == 'z') THEN 
     441      lread = dimlen(id) 
     442      IF (check) WRITE (*,*) "lread",lread 
     443    ENDIF 
    459444  ENDDO 
    460   iread = dimlen(1) 
    461   jread = dimlen(2) 
    462   lread = dimlen(3) 
    463445!- 
    464446  IF (id_unl > 0) THEN 
     
    469451!--- 
    470452    IF (l_rw) THEN 
    471       iret = NF90_INQUIRE_DIMENSION(ncfid,id_unl,len=tstp_out(fid)) 
     453      tstp_out(fid) = dimlen(id_unl) 
    472454      itau_out(fid) = -1 
    473       tdimid_out(fid) =  tdimid_in(fid)  
     455      tdimid_out(fid) =  tdimid_in(fid) 
     456      IF (check) THEN 
     457        WRITE (*,*) & 
     458 &       "restopenin 0.0 unlimited axis dimname", & 
     459 &       dimname(id_unl),tstp_out(fid) 
     460      ENDIF 
    474461!----- 
    475462      xax_nb(fid) = 0 
     
    478465!----- 
    479466      DO id=1,nb_dim 
    480         iret = NF90_INQUIRE_DIMENSION(ncfid,id,name=dimname) 
    481         IF      (dimname(1:1) == 'x') THEN 
     467        IF      (dimname(id)(1:1) == 'x') THEN 
    482468          xax_nb(fid) = xax_nb(fid)+1 
    483           iret = NF90_INQUIRE_DIMENSION & 
    484  &                 (ncfid,id,len=xax_infs(fid,xax_nb(fid),1)) 
     469          xax_infs(fid,xax_nb(fid),1) = dimlen(id) 
    485470          xax_infs(fid,xax_nb(fid),2) = id 
    486         ELSE IF (dimname(1:1) == 'y') THEN 
     471        ELSE IF (dimname(id)(1:1) == 'y') THEN 
    487472          yax_nb(fid) = yax_nb(fid)+1 
    488           iret = NF90_INQUIRE_DIMENSION & 
    489  &                 (ncfid,id,len=yax_infs(fid,yax_nb(fid),1)) 
     473          yax_infs(fid,yax_nb(fid),1) = dimlen(id) 
    490474          yax_infs(fid,yax_nb(fid),2) = id 
    491         ELSE IF (dimname(1:1) == 'z') THEN 
     475        ELSE IF (dimname(id)(1:1) == 'z') THEN 
    492476          zax_nb(fid) = zax_nb(fid)+1 
    493           iret = NF90_INQUIRE_DIMENSION & 
    494  &                 (ncfid,id,len=zax_infs(fid,zax_nb(fid),1)) 
     477          zax_infs(fid,zax_nb(fid),1) = dimlen(id) 
    495478          zax_infs(fid,zax_nb(fid),2) = id 
    496479        ENDIF 
     
    507490! 1.0 First let us check that we have the righ restart file 
    508491!- 
    509   IF (iread /= iim .OR. jread /= jjm .OR. lread /= llm) THEN 
    510     CALL ipslerr (3,'restopenin',& 
    511  &    'The grid of the restart file does not correspond',& 
    512  &    'to that of the model',' ') 
    513   ENDIF 
    514 !- 
    515 ! We know that we have a time axis. Thus the 4th dimension needs 
    516 ! to be the levels. 
    517 !- 
    518   IF (nb_dim > 3 .AND. dimlen(3) /= llm) THEN 
     492  IF ((iread /= iim).OR.(jread /= jjm).OR.(lread /= llm)) THEN 
    519493    CALL ipslerr (3,'restopenin',& 
    520494 &    'The grid of the restart file does not correspond',& 
     
    561535      ENDIF 
    562536      IF (     (INDEX(units,'seconds since') > 0) & 
    563           .AND.(tax_varid_in(fid) < 0) ) THEN     
     537          .AND.(tax_varid_in(fid) < 0) ) THEN 
    564538        tax_varid_in(fid) = iv 
    565539        tax_size_in(fid) = vardims_in(fid,iv,1) 
     
    578552  ENDDO 
    579553!- 
    580 ! 2.4 None of the variables was yet read  
     554! 2.4 None of the variables was yet read 
    581555!- 
    582556  nbvar_read(fid) = 0 
     
    616590!---- We can not test against epsilon here as the longitude 
    617591!---- can be stored at another precision in the netCDF file. 
    618 !---- The test here does not need to be very precise.             
     592!---- The test here does not need to be very precise. 
    619593!----- 
    620594      IF (mdlon > 1.e-4 .OR. mdlat > 1.e-4) THEN 
     
    628602!------------------------ 
    629603END SUBROUTINE restopenin 
    630 !- 
    631 !=== 
    632 !- 
    633 SUBROUTINE restsett (fid,timestep,date0) 
    634 !--------------------------------------------------------------------- 
    635 !- Here we get all the time information from the file.  
     604!=== 
     605SUBROUTINE restsett (timestep,date0,itau,owrite_time_in) 
     606!--------------------------------------------------------------------- 
     607!- Here we get all the time information from the file. 
    636608!- 
    637609!- The time information can come in three forms : 
     
    642614!- -A time-step axis exists and itau is positioned on it. 
    643615!- 
    644 !- What takes precedence ? No idea yet ! 
     616!- What takes precedence : the model 
     617!- 
     618!- itau     : Time step of the model 
     619!- 
     620!- Optional INPUT arguments 
     621!- 
     622!- owrite_time_in : logical  argument which allows to 
     623!-                  overwrite the time in the restart file 
    645624!--------------------------------------------------------------------- 
    646625  IMPLICIT NONE 
    647626!- 
    648   INTEGER :: fid 
    649627  REAL :: date0,timestep 
     628  INTEGER :: itau 
     629  LOGICAL,OPTIONAL :: owrite_time_in 
    650630!- 
    651631! LOCAL 
    652632!- 
    653   INTEGER :: ncfid,iret,it,iax,iv,tszij 
    654   INTEGER,ALLOCATABLE :: tmp_index(:,:) 
    655   REAL,ALLOCATABLE :: tmp_julian(:,:) 
     633  INTEGER :: ncfid,iret,it,iax,iv 
    656634  CHARACTER(LEN=80) :: itau_orig,tax_orig,calendar 
    657635  CHARACTER(LEN=9) :: tmp_cal 
    658636  INTEGER :: year0,month0,day0,hours0,minutes0,seci 
    659   REAL :: sec0,un_jour,un_an,date0_ju,ttmp 
     637  REAL :: sec0,one_day,one_year,date0_ju,ttmp 
    660638  CHARACTER :: strc 
     639  LOGICAL :: ow_time 
    661640!- 
    662641  LOGICAL :: check = .FALSE. 
    663642!--------------------------------------------------------------------- 
    664 !- 
    665   ncfid = netcdf_id(fid,1) 
    666 !- 
    667 !  Allocate the space we need for the time axes 
    668 !- 
    669   IF (.NOT.ALLOCATED(t_index) .AND. .NOT.ALLOCATED(t_julian) ) THEN 
    670     IF (check) THEN 
    671       WRITE(*,*) 'restsett : Allocate times axes at :', & 
    672                  max_file,tax_size_in(fid) 
    673     ENDIF 
    674     ALLOCATE(t_index(max_file,tax_size_in(fid))) 
    675     ALLOCATE(t_julian(max_file,tax_size_in(fid))) 
     643  IF (PRESENT(owrite_time_in)) THEN 
     644    ow_time = owrite_time_in 
    676645  ELSE 
    677     tszij = SIZE(t_index,DIM=2) 
    678     IF (tszij < tax_size_in(fid)) THEN 
     646    ow_time = .FALSE. 
     647  ENDIF 
     648!- 
     649  ncfid = netcdf_id(nb_fi,1) 
     650!- 
     651! Allocate the space we need for the time axes 
     652!- 
     653  CALL rest_atim (check,'restsett') 
     654!- 
     655! Get the calendar if possible. Else it will be gregorian. 
     656!- 
     657  IF (tax_size_in(nb_fi) > 0 ) THEN 
     658    calendar = 'XXXXX' 
     659    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',calendar) 
     660    IF ( INDEX(calendar,'XXXXX') < 0 ) THEN 
     661      CALL ioconf_calendar (calendar) 
    679662      IF (check) THEN 
    680         WRITE(*,*) 'restsett : Reallocate times axes at :', & 
    681                    max_file,tax_size_in(fid) 
     663        WRITE(*,*) 'restsett : calendar of the restart ',calendar 
    682664      ENDIF 
    683       ALLOCATE(tmp_index(max_file,tax_size_in(fid))) 
    684       ALLOCATE(tmp_julian(max_file,tax_size_in(fid))) 
    685       tmp_index(:,1:tszij) = t_index(:,1:tszij) 
    686       tmp_julian(:,1:tszij) = t_julian(:,1:tszij) 
    687       DEALLOCATE(t_index) 
    688       DEALLOCATE(t_julian) 
    689       ALLOCATE(t_index(max_file,tax_size_in(fid))) 
    690       ALLOCATE(t_julian(max_file,tax_size_in(fid))) 
    691       t_index(:,:) = tmp_index(:,:) 
    692       t_julian(:,:) = tmp_julian(:,:) 
    693     ENDIF 
    694   ENDIF 
    695 !- 
    696 ! Get the calendar if possible. Else it will be gregorian. 
    697 !- 
    698   IF (tax_size_in(fid) > 0 ) THEN 
    699      calendar = 'XXXXX' 
    700      iret = NF90_GET_ATT(ncfid,tax_varid_in(fid),'calendar',calendar) 
    701      IF ( INDEX(calendar,'XXXXX') < 0 ) THEN 
    702        CALL ioconf_calendar (calendar) 
    703      ENDIF 
    704   ENDIF 
    705   CALL ioget_calendar (un_an,un_jour) 
     665    ENDIF 
     666  ENDIF 
     667  CALL ioget_calendar (one_year,one_day) 
     668  IF (check) THEN 
     669    WRITE(*,*) 'one_year,one_day = ',one_year,one_day 
     670  ENDIF 
    706671!- 
    707672  itau_orig = 'XXXXX' 
     
    710675! Get the time steps of the time axis if available on the restart file 
    711676!- 
    712   IF (tind_varid_in(fid) > 0) THEN 
    713     iret = NF90_GET_VAR(ncfid,tind_varid_in(fid),t_index(fid,:)) 
    714     iret = NF90_GET_ATT(ncfid,tind_varid_in(fid),'units',itau_orig) 
    715     itau_orig = & 
    716       itau_orig(INDEX(itau_orig,'since')+6:LEN_TRIM(itau_orig)) 
    717     iret = & 
    718  &    NF90_GET_ATT(ncfid,tind_varid_in(fid),'tstep_sec',timestep) 
    719 !--- 
    720 !-- This time origin will dominate as it is linked to the time steps. 
    721 !--- 
    722     READ (UNIT=itau_orig,FMT='(I4.4,5(a,I2.2))') & 
    723  &    year0,strc,month0,strc,day0,strc, & 
    724  &    hours0,strc,minutes0,strc,seci 
    725     sec0 = REAL(seci) 
    726     sec0 = hours0*3600.+minutes0*60.+sec0 
    727     CALL ymds2ju (year0,month0,day0,sec0,date0) 
     677  IF (tind_varid_in(nb_fi) > 0) THEN 
     678    IF (ow_time) THEN 
     679      t_index(nb_fi,:) = itau 
     680      IF (check) THEN 
     681        WRITE(*,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:) 
     682      ENDIF 
     683      CALL ju2ymds (date0,year0,month0,day0,sec0) 
     684      hours0 = NINT(sec0/3600) 
     685      sec0 = sec0 - 3600 * hours0 
     686      minutes0 = NINT(sec0 / 60) 
     687      sec0 = sec0 - 60 * minutes0 
     688      seci = NINT(sec0) 
     689      strc=':' 
     690      IF (check) THEN 
     691        WRITE(*,*) date0 
     692        WRITE (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') & 
     693 &       year0,'-',month0,'-',day0,' ',hours0,':',minutes0,':',seci 
     694        WRITE(*,*) "itau_orig : ",itau_orig 
     695      ENDIF 
     696    ELSE 
     697      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:)) 
     698      IF (check) THEN 
     699        WRITE(*,*) "restsett, time axis : ",t_index(nb_fi,:) 
     700      ENDIF 
     701      iret = NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'units',itau_orig) 
     702      itau_orig = & 
     703 &      itau_orig(INDEX(itau_orig,'since')+6:LEN_TRIM(itau_orig)) 
     704      iret = & 
     705 &      NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'tstep_sec',timestep) 
     706!----- 
     707!---- This time origin will dominate as it is linked to the time steps. 
     708!----- 
     709      READ (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') & 
     710 &      year0,strc,month0,strc,day0,strc, & 
     711 &      hours0,strc,minutes0,strc,seci 
     712      sec0 = REAL(seci) 
     713      sec0 = hours0*3600.+minutes0*60.+sec0 
     714      CALL ymds2ju (year0,month0,day0,sec0,date0) 
     715    ENDIF 
    728716  ENDIF 
    729717!- 
    730718! If a julian day time axis is available then we get it 
    731719!- 
    732   IF (tax_varid_in(fid) > 0) THEN 
    733     iret = NF90_GET_VAR(ncfid,tax_varid_in(fid),t_julian(fid,:)) 
    734     iret = NF90_GET_ATT(ncfid,tax_varid_in(fid),'units',tax_orig) 
     720  IF (tax_varid_in(nb_fi) > 0) THEN 
     721    iret = NF90_GET_VAR(ncfid,tax_varid_in(nb_fi),t_julian(nb_fi,:)) 
     722    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'units',tax_orig) 
    735723    tax_orig = tax_orig(INDEX(tax_orig,'since')+6:LEN_TRIM(tax_orig)) 
    736     iret = NF90_GET_ATT(ncfid,tax_varid_in(fid),'calendar',tmp_cal) 
     724    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',tmp_cal) 
     725    IF (check) THEN 
     726      WRITE(*,*) 'restsett : tmp_calendar of the restart ',tmp_cal 
     727    ENDIF 
    737728!--- 
    738729    CALL strlowercase (tmp_cal) 
     
    757748    sec0 = hours0*3600.+minutes0*60.+sec0 
    758749    CALL ymds2ju (year0,month0,day0,sec0,date0_ju) 
    759     t_julian(fid,:) = t_julian(fid,:)/un_jour+date0_ju 
     750    t_julian(nb_fi,:) = t_julian(nb_fi,:)/one_day+date0_ju 
    760751  ENDIF 
    761752!- 
     
    767758  IF (     (INDEX(tax_orig,'XXXXX')  > 0) & 
    768759      .AND.(INDEX(itau_orig,'XXXXX') < 0) ) THEN 
    769     DO it=1,tax_size_in(fid) 
    770       t_julian(fid,it) = itau2date(t_index(fid,it),date0,timestep) 
     760    DO it=1,tax_size_in(nb_fi) 
     761      t_julian(nb_fi,it) = itau2date(t_index(nb_fi,it),date0,timestep) 
    771762    ENDDO 
    772763  ENDIF 
     
    775766! This is for compatibility reasons and should not be used. 
    776767!- 
    777   IF ( (tax_varid_in(fid) < 0) .AND. (tind_varid_in(fid) < 0) ) THEN 
     768  IF ((tax_varid_in(nb_fi) < 0).AND.(tind_varid_in(nb_fi) < 0)) THEN 
    778769    iax = -1 
    779     DO iv=1,nbvar_in(fid) 
    780       IF (INDEX(varname_in(fid,iv),'tsteps') > 0) THEN 
     770    DO iv=1,nbvar_in(nb_fi) 
     771      IF (    (INDEX(varname_in(nb_fi,iv),'tsteps') > 0) & 
     772 &        .OR.(INDEX(varname_in(nb_fi,iv),'time_steps') > 0)) THEN 
    781773        iax = iv 
    782774      ENDIF 
     
    789781        & ' ') 
    790782    ELSE 
    791       iret = NF90_GET_VAR(ncfid,tind_varid_in(fid),t_index(fid,:)) 
    792 !--- 
     783      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:)) 
    793784      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'delta_tstep_sec',timestep) 
    794785      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'year0',ttmp) 
     
    797788      month0 = NINT(ttmp) 
    798789      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'day0',ttmp) 
    799       day0 = NINT(ttmp)  
     790      day0 = NINT(ttmp) 
    800791      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'sec0',sec0) 
    801792!--- 
    802793      CALL ymds2ju (year0,month0,day0,sec0,date0) 
    803       t_julian(fid,1) = itau2date(t_index(fid,1),date0,timestep) 
     794      t_julian(nb_fi,1) = itau2date(t_index(nb_fi,1),date0,timestep) 
    804795    ENDIF 
    805796  ENDIF 
    806797!---------------------- 
    807798END SUBROUTINE restsett 
    808 !- 
    809 !=== 
    810 !- 
     799!=== 
    811800SUBROUTINE restopenout & 
    812801  (fid,fname,iim,jjm, & 
     
    873862  IF (check) WRITE(*,*) "restopenout 1.0" 
    874863!- 
    875   iret = NF90_DEF_VAR(ncfid,"nav_lon",NF90_FLOAT, & 
    876  &                     (/ x_id, y_id /),nlonid) 
     864  iret = NF90_DEF_VAR(ncfid,"nav_lon",NF90_FLOAT,(/x_id,y_id/),nlonid) 
    877865  iret = NF90_PUT_ATT(ncfid,nlonid,'units',"degrees_east") 
    878866  iret = NF90_PUT_ATT(ncfid,nlonid,'valid_min',REAL(-180.,KIND=4)) 
     
    884872  IF (check) WRITE(*,*) "restopenout 2.0" 
    885873!- 
    886   iret = NF90_DEF_VAR(ncfid,"nav_lat",NF90_FLOAT, & 
    887  &                     (/ x_id, y_id /),nlatid) 
     874  iret = NF90_DEF_VAR(ncfid,"nav_lat",NF90_FLOAT,(/x_id,y_id/),nlatid) 
    888875  iret = NF90_PUT_ATT(ncfid,nlatid,'units',"degrees_north") 
    889876  iret = NF90_PUT_ATT(ncfid,nlatid,'valid_min',REAL(-90.,KIND=4)) 
     
    902889 &                     REAL(MAXVAL(lev),KIND=4)) 
    903890  iret = NF90_PUT_ATT(ncfid,nlevid,'long_name',"Model levels") 
    904 !-  
     891!- 
    905892! 4.0 Time axis, this is the seconds since axis 
    906893!- 
     
    930917 &  year,cal(month),day,hours,minutes,INT(sec) 
    931918  iret = NF90_PUT_ATT(ncfid,timeid,'time_origin',TRIM(str_t)) 
    932 !-  
     919!- 
    933920! 5.0 Time axis, this is the time steps since axis 
    934921!- 
     
    994981!- 
    995982  iret = NF90_REDEF(ncfid) 
    996 !-  
     983!- 
    997984  IF (check) WRITE(*,*) "restopenout END" 
    998985!------------------------- 
    999986END SUBROUTINE restopenout 
    1000 !- 
    1001 !=== 
    1002 !- 
     987!=== 
    1003988SUBROUTINE restget_opp_r1d & 
    1004   (fid,vname_q,iim,jjm,llm,itau,def_beha, & 
    1005    var,OPERATOR,nbindex,ijndex) 
     989 & (fid,vname_q,iim,jjm,llm,itau,def_beha, & 
     990 &  var,MY_OPERATOR,nbindex,ijndex) 
    1006991!--------------------------------------------------------------------- 
    1007992!- This subroutine serves as an interface to restget_real 
     
    10161001  LOGICAL def_beha 
    10171002  REAL :: var(:) 
    1018   CHARACTER(LEN=*) :: OPERATOR 
     1003  CHARACTER(LEN=*) :: MY_OPERATOR 
    10191004  INTEGER :: nbindex,ijndex(nbindex) 
    10201005!- 
    1021 !- LOCAL 
    1022 !- 
    1023   INTEGER :: req_sz 
    1024   REAL,ALLOCATABLE,SAVE :: buff_tmp(:),buff_tmp2(:) 
     1006! LOCAL 
     1007!- 
     1008  INTEGER :: req_sz,siz1 
    10251009  REAL :: scal 
    10261010  CHARACTER(LEN=7) :: topp 
     
    10281012!--------------------------------------------------------------------- 
    10291013!- 
    1030 !  0.0 What size should be the data in the file 
     1014! 0.0 What size should be the data in the file 
    10311015!- 
    10321016  req_sz = 1 
     
    10411025  ENDIF 
    10421026!- 
    1043 !  1.0 Allocate the temporary buffer we need 
    1044 !      to put the variable in right dimension 
    1045 !- 
    1046   IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1047     IF (check) THEN 
    1048       WRITE(*,*) "restget_opp_r1d : allocate buff_tmp = ",SIZE(var) 
    1049     ENDIF 
    1050     ALLOCATE(buff_tmp(SIZE(var))) 
    1051   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1052     IF (check) THEN 
    1053       WRITE(*,*) "restget_opp_r1d : re-allocate buff_tmp= ",SIZE(var) 
    1054     ENDIF 
    1055     DEALLOCATE(buff_tmp) 
    1056     ALLOCATE(buff_tmp(SIZE(var))) 
    1057   ENDIF 
    1058 !- 
    1059   IF (.NOT.ALLOCATED(buff_tmp2)) THEN 
    1060     IF (check) THEN 
    1061       WRITE(*,*) "restget_opp_r1d : allocate buff_tmp2 = ",req_sz 
    1062     ENDIF 
    1063     ALLOCATE(buff_tmp2(req_sz)) 
    1064   ELSE IF (req_sz > SIZE(buff_tmp2)) THEN 
    1065     IF (check) THEN 
    1066       WRITE(*,*) "restget_opp_r1d : re-allocate buff_tmp2= ",req_sz 
    1067     ENDIF 
    1068     DEALLOCATE(buff_tmp2) 
    1069     ALLOCATE(buff_tmp2(req_sz)) 
    1070   ENDIF 
     1027! 1.0 Allocate the temporary buffer we need 
     1028!     to put the variable in right dimension 
     1029!- 
     1030  siz1 = SIZE(var) 
     1031  CALL rest_alloc (1,siz1,check,'restget_opp_r1d') 
     1032  CALL rest_alloc (2,req_sz,check,'restget_opp_r1d') 
    10711033!- 
    10721034! 2.0 Here we get the variable from the restart file 
     
    10761038     zax_infs(fid,1,1),itau,def_beha,buff_tmp2) 
    10771039!- 
    1078 !  4.0 Transfer the buffer obtained from the restart file 
    1079 !      into the variable the model expects 
    1080 !- 
    1081   topp = OPERATOR(1:MIN(LEN_TRIM(OPERATOR),7)) 
     1040! 4.0 Transfer the buffer obtained from the restart file 
     1041!     into the variable the model expects 
     1042!- 
     1043  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7)) 
    10821044!- 
    10831045  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN 
    10841046    scal = missing_val 
    1085 !--- 
    10861047    CALL mathop (topp,req_sz,buff_tmp2,missing_val, & 
    1087                  nbindex,ijndex,scal,SIZE(var),buff_tmp) 
    1088 !--- 
    1089     var(:) = buff_tmp(:)  
     1048 &               nbindex,ijndex,scal,siz1,buff_tmp1) 
     1049    var(:) = buff_tmp1(1:siz1) 
    10901050  ELSE 
    10911051    CALL ipslerr (3,'resget_opp_r1d', & 
     
    10951055!----------------------------- 
    10961056END SUBROUTINE restget_opp_r1d 
    1097 !- 
    1098 !=== 
    1099 !- 
     1057!=== 
    11001058SUBROUTINE restget_opp_r2d & 
    1101   (fid,vname_q,iim,jjm,llm,itau,def_beha, & 
    1102    var,OPERATOR,nbindex,ijndex) 
     1059 & (fid,vname_q,iim,jjm,llm,itau,def_beha, & 
     1060 &  var,MY_OPERATOR,nbindex,ijndex) 
    11031061!--------------------------------------------------------------------- 
    11041062!- This subroutine serves as an interface to restget_real 
     
    11131071  LOGICAL def_beha 
    11141072  REAL :: var(:,:) 
    1115   CHARACTER(LEN=*) :: OPERATOR 
     1073  CHARACTER(LEN=*) :: MY_OPERATOR 
    11161074  INTEGER :: nbindex,ijndex(nbindex) 
    11171075!- 
    1118 !- LOCAL 
    1119 !- 
    1120   INTEGER :: jj,req_sz,ist,var_sz 
    1121   REAL,ALLOCATABLE,SAVE :: buff_tmp(:),buff_tmp2(:) 
     1076! LOCAL 
     1077!- 
     1078  INTEGER :: jj,req_sz,ist,var_sz,siz1 
    11221079  REAL :: scal 
    11231080  CHARACTER(LEN=7) :: topp 
     
    11251082!--------------------------------------------------------------------- 
    11261083!- 
    1127 !  0.0 What size should be the data in the file 
     1084! 0.0 What size should be the data in the file 
    11281085!- 
    11291086  req_sz = 1 
     
    11461103!     to put the variable in right dimension 
    11471104!- 
    1148   IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1149     IF (check) THEN 
    1150       WRITE(*,*) "restget_opp_r2d : allocate buff_tmp = ",SIZE(var,1) 
    1151     ENDIF 
    1152     ALLOCATE(buff_tmp(SIZE(var,1))) 
    1153   ELSE IF (SIZE(var,1) > SIZE(buff_tmp)) THEN 
    1154     IF (check) THEN 
    1155       WRITE(*,*) "restget_opp_r2d : re-allocate buff_tmp= ",SIZE(var,1) 
    1156     ENDIF 
    1157     DEALLOCATE(buff_tmp) 
    1158     ALLOCATE(buff_tmp(SIZE(var,1))) 
    1159   ENDIF 
    1160 !- 
    1161   IF (.NOT.ALLOCATED(buff_tmp2)) THEN 
    1162     IF (check) THEN 
    1163       WRITE(*,*) "restget_opp_r2d : allocate buff_tmp2 = ",req_sz*jjm 
    1164     ENDIF 
    1165     ALLOCATE(buff_tmp2(req_sz*jjm)) 
    1166   ELSE IF (req_sz*jjm > SIZE(buff_tmp2)) THEN 
    1167     IF (check) THEN 
    1168       WRITE(*,*) "restget_opp_r2d : re-allocate buff_tmp2= ",req_sz*jjm 
    1169     ENDIF 
    1170     DEALLOCATE(buff_tmp2) 
    1171     ALLOCATE(buff_tmp2(req_sz*jjm)) 
    1172   ENDIF 
     1105  siz1 = SIZE(var,1) 
     1106  CALL rest_alloc (1,siz1,check,'restget_opp_r2d') 
     1107  CALL rest_alloc (2,req_sz*jjm,check,'restget_opp_r2d') 
    11731108!- 
    11741109! 2.0 Here we get the full variable from the restart file 
    11751110!- 
    11761111  CALL restget_real & 
    1177    (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), & 
    1178      jjm,itau,def_beha,buff_tmp2) 
    1179 !- 
    1180 !  4.0 Transfer the buffer obtained from the restart file 
    1181 !      into the variable the model expects 
    1182 !- 
    1183   topp = OPERATOR(1:MIN(LEN_TRIM(OPERATOR),7)) 
     1112 & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), & 
     1113 &  jjm,itau,def_beha,buff_tmp2) 
     1114!- 
     1115! 4.0 Transfer the buffer obtained from the restart file 
     1116!     into the variable the model expects 
     1117!- 
     1118  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7)) 
    11841119!- 
    11851120  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN 
    11861121    scal = missing_val 
    1187     var_sz = SIZE(var,1) 
    1188 !--- 
     1122    var_sz = siz1 
    11891123    DO jj = 1,jjm 
    11901124      ist = (jj-1)*req_sz+1 
    11911125      CALL mathop (topp,req_sz,buff_tmp2(ist:ist+req_sz-1), & 
    1192  &      missing_val,nbindex,ijndex,scal,var_sz,buff_tmp) 
    1193 !----- 
    1194       var(:,jj) = buff_tmp(:)  
     1126 &      missing_val,nbindex,ijndex,scal,var_sz,buff_tmp1) 
     1127      var(:,jj) = buff_tmp1(1:siz1) 
    11951128    ENDDO 
    11961129  ELSE 
     
    12011134!----------------------------- 
    12021135END SUBROUTINE restget_opp_r2d 
    1203 !- 
    1204 !=== 
    1205 !- 
     1136!=== 
    12061137SUBROUTINE restget_r1d & 
    1207   (fid,vname_q,iim,jjm,llm,itau,def_beha,var) 
     1138 & (fid,vname_q,iim,jjm,llm,itau,def_beha,var) 
    12081139!--------------------------------------------------------------------- 
    12091140!- This subroutine serves as an interface to restget_real 
     
    12171148  REAL :: var(:) 
    12181149!- 
    1219 !- LOCAL 
    1220 !- 
    1221   INTEGER :: ji,jl,req_sz,var_sz 
    1222   REAL,ALLOCATABLE,SAVE :: buff_tmp(:) 
     1150! LOCAL 
     1151!- 
     1152  INTEGER :: ji,jl,req_sz,var_sz,siz1 
    12231153  CHARACTER(LEN=70) :: str,str2 
    12241154  LOGICAL :: check = .FALSE. 
     
    12281158!     to put the variable in right dimension 
    12291159!- 
    1230   IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1231     IF (check) WRITE(*,*) "restget_r1d : allocate buff_tmp = ",SIZE(var) 
    1232     ALLOCATE(buff_tmp(SIZE(var))) 
    1233   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1234     IF (check) THEN 
    1235       WRITE(*,*) "restget_r1d : re-allocate buff_tmp= ",SIZE(var) 
    1236     ENDIF 
    1237     DEALLOCATE(buff_tmp) 
    1238     ALLOCATE(buff_tmp(SIZE(var))) 
    1239   ENDIF 
     1160  siz1 = SIZE(var) 
     1161  var_sz = siz1 
     1162  CALL rest_alloc (1,var_sz,check,'restget_r1d') 
    12401163!- 
    12411164! 2.0 Here we could check if the sizes specified agree 
     
    12461169  IF (jjm > 0) req_sz = req_sz*jjm 
    12471170  IF (llm > 0) req_sz = req_sz*llm 
    1248   var_sz = SIZE(var,1) 
    12491171  IF (req_sz > var_sz) THEN 
    12501172    WRITE(str, & 
     
    12641186!- 
    12651187  CALL restget_real & 
    1266     (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp) 
     1188 & (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1) 
    12671189!- 
    12681190! 4.0 Transfer the buffer obtained from the restart file 
     
    12701192!- 
    12711193  jl=0 
    1272   DO ji=1,SIZE(var,1) 
     1194  DO ji=1,siz1 
    12731195    jl=jl+1 
    1274     var(ji) = buff_tmp(jl) 
     1196    var(ji) = buff_tmp1(jl) 
    12751197  ENDDO 
    12761198!------------------------- 
    12771199END SUBROUTINE restget_r1d 
    1278 !- 
    1279 !=== 
    1280 !- 
     1200!=== 
    12811201SUBROUTINE restget_r2d & 
    1282   (fid,vname_q,iim,jjm,llm,itau,def_beha,var) 
     1202 & (fid,vname_q,iim,jjm,llm,itau,def_beha,var) 
    12831203!--------------------------------------------------------------------- 
    12841204!- This subroutine serves as an interface to restget_real 
     
    12921212  REAL :: var(:,:) 
    12931213!- 
    1294 !- LOCAL 
    1295 !- 
    1296   INTEGER :: ji,jj,jl,req_sz,var_sz 
    1297   REAL,ALLOCATABLE,SAVE :: buff_tmp(:) 
     1214! LOCAL 
     1215!- 
     1216  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2 
    12981217  CHARACTER(LEN=70) :: str,str2 
    12991218  LOGICAL :: check = .FALSE. 
    13001219!--------------------------------------------------------------------- 
    13011220!- 
    1302 !  1.0 Allocate the temporary buffer we need 
    1303 !      to put the variable in right dimension 
    1304 !- 
    1305   IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1306     IF (check) THEN 
    1307       WRITE(*,*) "restget_r2d : allocate buff_tmp = ",SIZE(var) 
    1308     ENDIF 
    1309     ALLOCATE(buff_tmp(SIZE(var))) 
    1310   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1311     IF (check) THEN 
    1312       WRITE(*,*) "restget_r2d : re-allocate buff_tmp= ",SIZE(var) 
    1313     ENDIF 
    1314     DEALLOCATE(buff_tmp) 
    1315     ALLOCATE(buff_tmp(SIZE(var))) 
    1316   ENDIF 
     1221! 1.0 Allocate the temporary buffer we need 
     1222!     to put the variable in right dimension 
     1223!- 
     1224  siz1 = SIZE(var,1) 
     1225  siz2 = SIZE(var,2) 
     1226  var_sz = siz1*siz2 
     1227  CALL rest_alloc (1,var_sz,check,'restget_r2d') 
    13171228!- 
    13181229! 2.0 Here we check if the sizes specified agree 
    1319 !-    with the size of the variable provided 
     1230!     with the size of the variable provided 
    13201231!- 
    13211232  req_sz = 1 
     
    13231234  IF (jjm > 0) req_sz = req_sz*jjm 
    13241235  IF (llm > 0) req_sz = req_sz*llm 
    1325   var_sz = SIZE(var,2)*SIZE(var,1) 
    13261236  IF (req_sz > var_sz) THEN 
    1327     WRITE(*,*) "RESGET_r2d :",vname_q 
    13281237    WRITE(str, & 
    1329  &    '("Size of variable requested from file should be ",I6)') req_sz 
     1238 &    '("Size of variable ",A, & 
     1239 &      //" requested from file should be ",I6)') TRIM(vname_q),req_sz 
    13301240    WRITE(str2, & 
    1331  &    '("but the provided variable can only hold ",I6)')  var_sz 
     1241 &    '("but the provided variable can only hold ",I6)') var_sz 
    13321242    CALL ipslerr (3,'restget_r2d',str,str2,' ') 
    13331243  ENDIF 
    13341244  IF (req_sz < var_sz) THEN 
    13351245    WRITE(str, & 
    1336  &    '("the size of variable requested from file is ",I6)') req_sz 
    1337     WRITE(str2,'("but the provided variable can hold ",I6)')  var_sz 
     1246 &    '("Size of variable ",A, & 
     1247 &      //" requested from file is ",I6)') TRIM(vname_q),req_sz 
     1248    WRITE(str2,'("but the provided variable can hold ",I6)') var_sz 
    13381249    CALL ipslerr (2,'restget_r2d', & 
    13391250      'There could be a problem here :',str,str2) 
     
    13411252!- 
    13421253  CALL restget_real & 
    1343     (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp) 
     1254 & (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1) 
    13441255!- 
    13451256! 4.0 Transfer the buffer obtained from the restart file 
     
    13471258!- 
    13481259  jl=0 
    1349   DO jj=1,SIZE(var,2) 
    1350     DO ji=1,SIZE(var,1) 
     1260  DO jj=1,siz2 
     1261    DO ji=1,siz1 
    13511262      jl=jl+1 
    1352       var(ji,jj) = buff_tmp(jl) 
     1263      var(ji,jj) = buff_tmp1(jl) 
    13531264    ENDDO 
    13541265  ENDDO 
    13551266!------------------------- 
    13561267END SUBROUTINE restget_r2d 
    1357 !- 
    1358 !=== 
    1359 !- 
     1268!=== 
    13601269SUBROUTINE restget_r3d & 
    13611270  (fid,vname_q,iim,jjm,llm,itau,def_beha,var) 
     
    13731282! LOCAL 
    13741283!- 
    1375   INTEGER :: ji,jj,jk,jl,req_sz,var_sz 
    1376   REAL,ALLOCATABLE,SAVE :: buff_tmp(:) 
     1284  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3 
    13771285  CHARACTER(LEN=70) :: str,str2 
    13781286  LOGICAL :: check = .FALSE. 
     
    13801288!- 
    13811289! 1.0 Allocate the temporary buffer we need 
    1382 !      to put the variable in right dimension 
    1383 !- 
    1384   IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1385     IF (check) WRITE(*,*) "restget_r3d : allocate buff_tmp = ",SIZE(var) 
    1386     ALLOCATE(buff_tmp(SIZE(var))) 
    1387   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1388     IF (check) THEN 
    1389       WRITE(*,*) "restget_r3d : re-allocate buff_tmp= ",SIZE(var) 
    1390     ENDIF 
    1391     DEALLOCATE(buff_tmp) 
    1392     ALLOCATE(buff_tmp(SIZE(var))) 
    1393   ENDIF 
     1290!     to put the variable in right dimension 
     1291!- 
     1292  siz1 = SIZE(var,1) 
     1293  siz2 = SIZE(var,2) 
     1294  siz3 = SIZE(var,3) 
     1295  var_sz = siz1*siz2*siz3 
     1296  CALL rest_alloc (1,var_sz,check,'restget_r3d') 
    13941297!- 
    13951298! 2.0 Here we check if the sizes specified agree 
    1396 !-    with the size of the variable provided 
     1299!     with the size of the variable provided 
    13971300!- 
    13981301  req_sz = 1 
     
    14001303  IF (jjm > 0) req_sz = req_sz*jjm 
    14011304  IF (llm > 0) req_sz = req_sz*llm 
    1402   var_sz = SIZE(var,3)*SIZE(var,2)*SIZE(var,1) 
    14031305  IF (req_sz > var_sz) THEN 
    14041306    WRITE(str, & 
    1405  &    '("Size of variable requested from file should be ",I6)') req_sz 
     1307 &    '("Size of variable ",A, & 
     1308 &      //" requested from file should be ",I6)') TRIM(vname_q),req_sz 
    14061309    WRITE(str2, & 
    1407  &    '("but the provided variable can only hold ",I6)')  var_sz 
     1310 &    '("but the provided variable can only hold ",I6)') var_sz 
    14081311    CALL ipslerr (3,'restget_r3d',str,str2,' ') 
    14091312  ENDIF 
    14101313  IF (req_sz < var_sz) THEN 
    14111314    WRITE(str, & 
    1412  &    '("the size of variable requested from file is ",I6)') req_sz 
    1413     WRITE(str2,'("but the provided variable can hold ",I6)')  var_sz 
     1315 &    '("Size of variable ",A, & 
     1316 &      //" requested from file is ",I6)') TRIM(vname_q),req_sz 
     1317    WRITE(str2,'("but the provided variable can hold ",I6)') var_sz 
    14141318    CALL ipslerr (2,'restget_r3d', & 
    14151319      'There could be a problem here :',str,str2) 
     
    14171321!- 
    14181322  CALL restget_real & 
    1419     (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp) 
     1323    (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1) 
    14201324!- 
    14211325! 4.0 Transfer the buffer obtained from the restart file 
     
    14231327!- 
    14241328  jl=0 
    1425   DO jk=1,SIZE(var,3) 
    1426     DO jj=1,SIZE(var,2) 
    1427       DO ji=1,SIZE(var,1) 
     1329  DO jk=1,siz3 
     1330    DO jj=1,siz2 
     1331      DO ji=1,siz1 
    14281332        jl=jl+1 
    1429         var(ji,jj,jk) = buff_tmp(jl) 
     1333        var(ji,jj,jk) = buff_tmp1(jl) 
    14301334      ENDDO 
    14311335    ENDDO 
     
    14331337!------------------------- 
    14341338END SUBROUTINE restget_r3d 
    1435 !- 
    1436 !=== 
    1437 !- 
     1339!=== 
    14381340SUBROUTINE restget_real & 
    14391341  (fid,vname_q,iim,jjm,llm,itau,def_beha,var) 
     
    15061408      touched_in(fid,vnb) = .TRUE. 
    15071409!----- 
    1508       CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.)  
     1410      CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.) 
    15091411!----- 
    15101412    ELSE 
     
    15351437    index = -1 
    15361438    DO it=1,tax_size_in(fid) 
    1537           IF (t_index(fid,it) == itau) index = it 
     1439      IF (t_index(fid,it) == itau) index = it 
    15381440    ENDDO 
    15391441!--- 
     
    15431445 &      str,'is not available in the current file',' ') 
    15441446    ENDIF 
    1545 !---      
     1447!--- 
    15461448!-- 4.0 Read the data. Note that the variables in the restart files 
    15471449!--     have no time axis is and thus we write -1 
     
    15561458      ELSE 
    15571459        WRITE (str2,'("Incompatibility for iim : ",I6,I6)') & 
    1558              iim,vardims_in(fid,vnb,ndim)  
     1460             iim,vardims_in(fid,vnb,ndim) 
    15591461        CALL ipslerr (3,'restget',str,str2,' ') 
    15601462      ENDIF 
     
    15681470      ELSE 
    15691471        WRITE (str2,'("Incompatibility for jjm : ",I6,I6)') & 
    1570              jjm,vardims_in(fid,vnb,ndim)  
     1472             jjm,vardims_in(fid,vnb,ndim) 
    15711473        CALL ipslerr (3,'restget',str,str2,' ') 
    15721474      ENDIF 
     
    15801482      ELSE 
    15811483        WRITE (str2,'("Incompatibility for llm : ",I6,I6)') & 
    1582              llm,vardims_in(fid,vnb,ndim)  
     1484             llm,vardims_in(fid,vnb,ndim) 
    15831485        CALL ipslerr (3,'restget',str,str2,' ') 
    15841486      ENDIF 
     
    16171519!-------------------------- 
    16181520END SUBROUTINE restget_real 
    1619 !- 
    1620 !=== 
    1621 !- 
     1521!=== 
    16221522SUBROUTINE restput_opp_r1d & 
    1623   (fid,vname_q,iim,jjm,llm,itau,var,OPERATOR,nbindex,ijndex) 
     1523 & (fid,vname_q,iim,jjm,llm,itau,var,MY_OPERATOR,nbindex,ijndex) 
    16241524!--------------------------------------------------------------------- 
    16251525!- This subroutine is the interface to restput_real which allows 
     
    16391539  INTEGER :: iim,jjm,llm,itau 
    16401540  REAL :: var(:) 
    1641   CHARACTER(LEN=*) :: OPERATOR 
     1541  CHARACTER(LEN=*) :: MY_OPERATOR 
    16421542  INTEGER :: nbindex,ijndex(nbindex) 
    16431543!- 
    16441544! LOCAL 
    16451545!- 
    1646   INTEGER :: req_sz 
    1647   REAL,ALLOCATABLE,SAVE :: buff_tmp(:),buff_tmp2(:) 
     1546  INTEGER :: req_sz,siz1 
    16481547  REAL :: scal 
    16491548  CHARACTER(LEN=7) :: topp 
     
    16671566!     to put the variable in right dimension 
    16681567!- 
    1669   IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1670     IF (check) THEN 
    1671       WRITE(*,*) "restput_opp_r1d : allocate buff_tmp = ",SIZE(var) 
    1672     ENDIF 
    1673     ALLOCATE(buff_tmp(SIZE(var))) 
    1674   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1675     IF (check) THEN 
    1676       WRITE(*,*) "restput_opp_r1d : re-allocate buff_tmp= ",SIZE(var) 
    1677     ENDIF 
    1678     DEALLOCATE(buff_tmp) 
    1679     ALLOCATE(buff_tmp(SIZE(var))) 
    1680   ENDIF 
    1681 !- 
    1682   IF (.NOT.ALLOCATED(buff_tmp2)) THEN 
    1683     IF (check) THEN 
    1684       WRITE(*,*) "restput_opp_r1d : allocate buff_tmp2 = ",req_sz 
    1685     ENDIF 
    1686     ALLOCATE(buff_tmp2(req_sz)) 
    1687   ELSE IF (req_sz > SIZE(buff_tmp2)) THEN 
    1688     IF (check) THEN 
    1689       WRITE(*,*) "restput_opp_r1d : re-allocate buff_tmp2= ",req_sz 
    1690     ENDIF 
    1691     DEALLOCATE(buff_tmp2) 
    1692     ALLOCATE(buff_tmp2(req_sz)) 
    1693   ENDIF 
     1568  siz1 = SIZE(var) 
     1569  CALL rest_alloc (1,siz1,check,'restput_opp_r1d') 
     1570  CALL rest_alloc (2,req_sz,check,'restput_opp_r1d') 
    16941571!- 
    16951572! 2.0 We do the operation needed. 
     
    16971574!     You would not want to change the values in a restart file or ? 
    16981575!- 
    1699   topp = OPERATOR(1:MIN(LEN_TRIM(OPERATOR),7)) 
     1576  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7)) 
    17001577!- 
    17011578  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN 
    17021579    scal = missing_val 
    1703 !--- 
    1704     buff_tmp(:) = var(:) 
    1705 !--- 
     1580    buff_tmp1(1:siz1) = var(:) 
    17061581    CALL mathop & 
    1707       (topp,SIZE(var),buff_tmp,missing_val,nbindex,ijndex, & 
    1708        scal,req_sz,buff_tmp2) 
     1582 &    (topp,siz1,buff_tmp1,missing_val,nbindex,ijndex, & 
     1583 &     scal,req_sz,buff_tmp2) 
    17091584  ELSE 
    17101585    CALL ipslerr (3,'restput_opp_r1d', & 
    1711       'The operation you wish to do on the variable for the ', & 
    1712        & 'restart file is not allowed.',topp) 
     1586 &    'The operation you wish to do on the variable for the ', & 
     1587 &    'restart file is not allowed.',topp) 
    17131588  ENDIF 
    17141589!- 
    17151590  CALL restput_real & 
    1716    (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), & 
    1717      zax_infs(fid,1,1),itau,buff_tmp2) 
     1591 & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), & 
     1592 &  zax_infs(fid,1,1),itau,buff_tmp2) 
    17181593!----------------------------- 
    17191594END SUBROUTINE restput_opp_r1d 
    1720 !- 
    1721 !=== 
    1722 !- 
     1595!=== 
    17231596SUBROUTINE restput_opp_r2d & 
    1724   (fid,vname_q,iim,jjm,llm,itau,var,OPERATOR,nbindex,ijndex) 
     1597 & (fid,vname_q,iim,jjm,llm,itau,var,MY_OPERATOR,nbindex,ijndex) 
    17251598!--------------------------------------------------------------------- 
    17261599!- This subroutine is the interface to restput_real which allows 
     
    17311604!- In the case iim = nbindex it means that the user attempts 
    17321605!- to project the first dimension of the matrix back onto a 3D field 
    1733 !- where jjm will be the third dimension.  
     1606!- where jjm will be the third dimension. 
    17341607!- Here we do not allow for 4D data, thus we will take the first 
    17351608!- two dimensions in the file and require that llm = 1. 
     
    17431616  INTEGER :: iim,jjm,llm,itau 
    17441617  REAL :: var(:,:) 
    1745   CHARACTER(LEN=*) :: OPERATOR 
     1618  CHARACTER(LEN=*) :: MY_OPERATOR 
    17461619  INTEGER :: nbindex,ijndex(nbindex) 
    17471620!- 
    17481621! LOCAL 
    17491622!- 
    1750   INTEGER :: jj,req_sz,var_sz,ist 
    1751   REAL,ALLOCATABLE,SAVE :: buff_tmp(:),buff_tmp2(:) 
     1623  INTEGER :: jj,req_sz,ist,siz1 
    17521624  REAL :: scal 
    17531625  CHARACTER(LEN=7) :: topp 
     
    17761648!     to put the variable in right dimension 
    17771649!- 
    1778   IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1779     IF (check) THEN 
    1780       WRITE(*,*) "restput_opp_r2d : allocate buff_tmp = ",SIZE(var,1) 
    1781     ENDIF 
    1782     ALLOCATE(buff_tmp(SIZE(var,1))) 
    1783   ELSE IF (SIZE(var,1) > SIZE(buff_tmp)) THEN 
    1784     IF (check) THEN 
    1785       WRITE(*,*) "restput_opp_r2d : re-allocate buff_tmp= ",SIZE(var,1) 
    1786     ENDIF 
    1787     DEALLOCATE(buff_tmp) 
    1788     ALLOCATE(buff_tmp(SIZE(var,1))) 
    1789   ENDIF 
    1790 !- 
    1791   IF (.NOT.ALLOCATED(buff_tmp2)) THEN 
    1792     IF (check) THEN 
    1793       WRITE(*,*) "restput_opp_r2d : allocate buff_tmp2 = ",req_sz*jjm 
    1794     ENDIF 
    1795     ALLOCATE(buff_tmp2(req_sz*jjm)) 
    1796   ELSE IF (req_sz*jjm > SIZE(buff_tmp2)) THEN 
    1797     IF (check) THEN 
    1798       WRITE(*,*) "restput_opp_r2d : re-allocate buff_tmp2= ",req_sz*jjm 
    1799     ENDIF 
    1800     DEALLOCATE(buff_tmp2) 
    1801     ALLOCATE(buff_tmp2(req_sz*jjm)) 
    1802   ENDIF 
     1650  siz1 = SIZE(var,1) 
     1651  CALL rest_alloc (1,siz1,check,'restput_opp_r2d') 
     1652  CALL rest_alloc (2,req_sz*jjm,check,'restput_opp_r2d') 
    18031653!- 
    18041654! 2.0 We do the operation needed. 
     
    18061656!     You would not want to change the values in a restart file or ? 
    18071657!- 
    1808   topp = OPERATOR(1:MIN(LEN_TRIM(OPERATOR),7)) 
     1658  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7)) 
    18091659!- 
    18101660  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN 
    18111661    scal = missing_val 
    1812     var_sz = SIZE(var,1) 
    1813 !--- 
    18141662    DO jj = 1,jjm 
    1815       buff_tmp(:) = var(:,jj) 
    1816 !----- 
     1663      buff_tmp1(1:siz1) = var(:,jj) 
    18171664      ist = (jj-1)*req_sz+1 
    18181665      CALL mathop & 
    1819         (topp,var_sz,buff_tmp,missing_val,nbindex,ijndex, & 
    1820          scal,req_sz,buff_tmp2(ist:ist+req_sz-1)) 
     1666 &      (topp,siz1,buff_tmp1,missing_val,nbindex,ijndex, & 
     1667 &       scal,req_sz,buff_tmp2(ist:ist+req_sz-1)) 
    18211668    ENDDO 
    18221669  ELSE 
    18231670    CALL ipslerr (3,'restput_opp_r2d', & 
    1824       'The operation you wish to do on the variable for the ', & 
    1825       'restart file is not allowed.',topp) 
     1671 &    'The operation you wish to do on the variable for the ', & 
     1672 &    'restart file is not allowed.',topp) 
    18261673  ENDIF 
    18271674!- 
    18281675  CALL restput_real & 
    1829    (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), & 
    1830      jjm,itau,buff_tmp2) 
     1676 & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), & 
     1677 &  jjm,itau,buff_tmp2) 
    18311678!----------------------------- 
    18321679END SUBROUTINE restput_opp_r2d 
    1833 !- 
    1834 !=== 
    1835 !- 
     1680!=== 
    18361681SUBROUTINE restput_r1d (fid,vname_q,iim,jjm,llm,itau,var) 
    18371682!--------------------------------------------------------------------- 
     
    18471692! LOCAL 
    18481693!- 
    1849   INTEGER :: ji,jl,req_sz,var_sz 
    1850   REAL,ALLOCATABLE,SAVE :: buff_tmp(:) 
     1694  INTEGER :: ji,jl,req_sz,var_sz,siz1 
    18511695  CHARACTER(LEN=70) :: str,str2 
    18521696  LOGICAL :: check = .FALSE. 
     
    18541698!- 
    18551699! 1.0 Allocate the temporary buffer we need 
    1856 !      to put the variable in right dimension 
    1857 !- 
    1858   IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1859     IF (check) THEN 
    1860       WRITE(*,*) "restput_r1d : allocate buff_tmp = ",SIZE(var) 
    1861     ENDIF 
    1862     ALLOCATE(buff_tmp(SIZE(var))) 
    1863   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1864     IF (check) THEN 
    1865       WRITE(*,*) "restput_r1d : re-allocate buff_tmp= ",SIZE(var) 
    1866     ENDIF 
    1867     DEALLOCATE(buff_tmp) 
    1868     ALLOCATE(buff_tmp(SIZE(var))) 
    1869   ENDIF 
     1700!     to put the variable in right dimension 
     1701!- 
     1702  siz1 = SIZE(var) 
     1703  var_sz = siz1 
     1704  CALL rest_alloc (1,var_sz,check,'restput_r1d') 
    18701705!- 
    18711706! 2.0 Here we could check if the sizes specified agree 
     
    18761711  IF (jjm > 0) req_sz = req_sz*jjm 
    18771712  IF (llm > 0) req_sz = req_sz*llm 
    1878   var_sz = SIZE(var,1) 
    18791713  IF (req_sz > var_sz) THEN 
    18801714    WRITE(str, & 
    18811715 &    '("Size of variable put to the file should be ",I6)') req_sz 
    18821716    WRITE(str2, & 
    1883  &    '("but the provided variable is of size  ",I6)') var_sz 
     1717 &    '("but the provided variable is of size ",I6)') var_sz 
    18841718    CALL ipslerr (3,'restput_r1d',str,str2,' ') 
    18851719  ENDIF 
    18861720  IF (req_sz < var_sz) THEN 
    18871721    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz 
    1888     WRITE(str2,'("but the provided variable is larger ",I6)')  var_sz 
     1722    WRITE(str2,'("but the provided variable is larger ",I6)') var_sz 
    18891723    CALL ipslerr (2,'restput_r1d', & 
    18901724      'There could be a problem here :',str,str2) 
     
    18951729!- 
    18961730  jl=0 
    1897   DO ji=1,SIZE(var,1) 
     1731  DO ji=1,siz1 
    18981732    jl=jl+1 
    1899     buff_tmp(jl) = var(ji) 
     1733    buff_tmp1(jl) = var(ji) 
    19001734  ENDDO 
    19011735!- 
    1902   CALL restput_real (fid,vname_q,iim,jjm,llm,itau,buff_tmp) 
     1736  CALL restput_real (fid,vname_q,iim,jjm,llm,itau,buff_tmp1) 
    19031737!------------------------- 
    19041738END SUBROUTINE restput_r1d 
    1905 !- 
    1906 !=== 
    1907 !- 
     1739!=== 
    19081740SUBROUTINE restput_r2d (fid,vname_q,iim,jjm,llm,itau,var) 
    19091741!--------------------------------------------------------------------- 
     
    19191751! LOCAL 
    19201752!- 
    1921   INTEGER :: ji,jj,jl,req_sz,var_sz 
    1922   REAL,ALLOCATABLE,SAVE :: buff_tmp(:) 
     1753  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2 
    19231754  CHARACTER(LEN=70) :: str,str2 
    19241755  LOGICAL :: check = .FALSE. 
     
    19281759!     to put the variable in right dimension 
    19291760!- 
    1930   IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    1931     IF (check) WRITE(*,*) "restput_r2d : allocate buff_tmp = ",SIZE(var) 
    1932     ALLOCATE(buff_tmp(SIZE(var))) 
    1933   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    1934     IF (check) THEN 
    1935       WRITE(*,*) "restput_r2d : re-allocate buff_tmp= ",SIZE(var) 
    1936     ENDIF 
    1937     DEALLOCATE(buff_tmp) 
    1938     ALLOCATE(buff_tmp(SIZE(var))) 
    1939   ENDIF 
     1761  siz1 = SIZE(var,1) 
     1762  siz2 = SIZE(var,2) 
     1763  var_sz = siz1*siz2 
     1764  CALL rest_alloc (1,var_sz,check,'restput_r2d') 
    19401765!- 
    19411766! 2.0 Here we could check if the sizes specified agree 
     
    19461771  IF (jjm > 0) req_sz = req_sz*jjm 
    19471772  IF (llm > 0) req_sz = req_sz*llm 
    1948   var_sz = SIZE(var,2)*SIZE(var,1) 
    19491773  IF (req_sz > var_sz) THEN 
    19501774    WRITE(str, & 
     
    19641788!- 
    19651789  jl=0 
    1966   DO jj=1,SIZE(var,2) 
    1967     DO ji=1,SIZE(var,1) 
     1790  DO jj=1,siz2 
     1791    DO ji=1,siz1 
    19681792      jl=jl+1 
    1969       buff_tmp(jl) = var(ji,jj) 
     1793      buff_tmp1(jl) = var(ji,jj) 
    19701794    ENDDO 
    19711795  ENDDO 
    19721796!- 
    1973   CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp) 
     1797  CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp1) 
    19741798!------------------------- 
    19751799END SUBROUTINE restput_r2d 
    1976 !- 
    1977 !=== 
    1978 !- 
     1800!=== 
    19791801SUBROUTINE restput_r3d (fid,vname_q,iim,jjm,llm,itau,var) 
    19801802!--------------------------------------------------------------------- 
     
    19901812! LOCAL 
    19911813!- 
    1992   INTEGER :: ji,jj,jk,jl,req_sz,var_sz 
    1993   REAL,ALLOCATABLE,SAVE :: buff_tmp(:) 
     1814  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3 
    19941815  CHARACTER(LEN=70) :: str,str2 
    19951816  LOGICAL :: check = .FALSE. 
     
    19991820!     to put the variable in right dimension 
    20001821!- 
    2001   IF (.NOT.ALLOCATED(buff_tmp)) THEN 
    2002     IF (check) THEN 
    2003       WRITE(*,*) "restput_r3d : allocate buff_tmp = ",SIZE(var) 
    2004     ENDIF 
    2005     ALLOCATE(buff_tmp(SIZE(var))) 
    2006   ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 
    2007     IF (check) THEN 
    2008       WRITE(*,*) "restput_r3d : re-allocate buff_tmp= ",SIZE(var) 
    2009     ENDIF 
    2010     DEALLOCATE(buff_tmp) 
    2011     ALLOCATE(buff_tmp(SIZE(var))) 
    2012   ENDIF 
     1822  siz1 = SIZE(var,1) 
     1823  siz2 = SIZE(var,2) 
     1824  siz3 = SIZE(var,3) 
     1825  var_sz = siz1*siz2*siz3 
     1826  CALL rest_alloc (1,var_sz,check,'restput_r3d') 
    20131827!- 
    20141828! 2.0 Here we could check if the sizes specified agree 
     
    20191833  IF (jjm > 0) req_sz = req_sz*jjm 
    20201834  IF (llm > 0) req_sz = req_sz*llm 
    2021   var_sz = SIZE(var,3)*SIZE(var,2)*SIZE(var,1) 
    20221835  IF (req_sz > var_sz) THEN 
    20231836    WRITE(str, & 
     
    20381851!- 
    20391852  jl=0 
    2040   DO jk=1,SIZE(var,3) 
    2041     DO jj=1,SIZE(var,2) 
    2042       DO ji=1,SIZE(var,1) 
     1853  DO jk=1,siz3 
     1854    DO jj=1,siz2 
     1855      DO ji=1,siz1 
    20431856        jl=jl+1 
    2044         buff_tmp(jl) = var(ji,jj,jk) 
     1857        buff_tmp1(jl) = var(ji,jj,jk) 
    20451858      ENDDO 
    20461859    ENDDO 
    20471860  ENDDO 
    20481861!- 
    2049   CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp) 
     1862  CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp1) 
    20501863!------------------------- 
    20511864END SUBROUTINE restput_r3d 
    2052 !- 
    2053 !=== 
    2054 !- 
     1865!=== 
    20551866SUBROUTINE restput_real (fid,vname_q,iim,jjm,llm,itau,var) 
    20561867!--------------------------------------------------------------------- 
    2057 !- This subroutine will put a variable into the restart file.  
     1868!- This subroutine will put a variable into the restart file. 
    20581869!- But it will do a lot of other things if needed : 
    20591870!- - Open a file if non is opened for this time-step 
     
    20881899  INTEGER :: iret,vid,ncid,iv,vnb 
    20891900  INTEGER :: ierr 
    2090   REAL :: secsince,un_jour,un_an 
     1901  REAL :: secsince,one_day,one_year 
    20911902  INTEGER :: ndims 
    20921903  INTEGER,DIMENSION(4) :: corner,edge 
     
    21021913 &    'The output restart file is undefined.',' ',' ') 
    21031914  ENDIF 
    2104   CALL ioget_calendar (un_an,un_jour) 
    2105 !- 
    2106 ! 1.0 Check if the variable is already present  
     1915  CALL ioget_calendar (one_year,one_day) 
     1916!- 
     1917! 1.0 Check if the variable is already present 
    21071918!- 
    21081919  IF (check) WRITE(*,*) 'RESTPUT 1.0 : ',TRIM(vname_q) 
     
    21321943    iret = NF90_ENDDEF(ncid) 
    21331944  ENDIF 
    2134 !-      
     1945!- 
    21351946! 3.0 Is this itau already on the axis ? 
    21361947!     If not then check that all variables of previous time is OK. 
     
    22072018  ENDIF 
    22082019  ndims = ndims+1 
    2209   corner(ndims) = tstp_out(fid)  
     2020  corner(ndims) = tstp_out(fid) 
    22102021  edge(ndims) = 1 
    22112022!- 
     
    22142025!- 
    22152026  IF (iret /= NF90_NOERR) THEN 
    2216     WRITE (*,*) ' restput error ',NF90_STRERROR(iret) 
     2027    CALL ipslerr (2,'restput_real',NF90_STRERROR(iret), & 
     2028 &    'Bug in restput.',& 
     2029 &    'Please, verify compatibility between get and put commands.') 
    22172030  ENDIF 
    22182031!- 
     
    22222035!--------------------------- 
    22232036END  SUBROUTINE restput_real 
    2224 !- 
    2225 !=== 
    2226 !- 
     2037!=== 
    22272038SUBROUTINE restdefv (fid,varname,iim,jjm,llm,write_att) 
    22282039!--------------------------------------------------------------------- 
    22292040! This subroutine adds a variable to the output file. 
    2230 ! The attributes are either taken from . 
     2041! The attributes are either taken from. 
    22312042!--------------------------------------------------------------------- 
    22322043  IMPLICIT NONE 
     
    22562067! 0.0 Put the file in define mode if needed 
    22572068!- 
    2258   IF (itau_out(fid) >= 0) THEN  
     2069  IF (itau_out(fid) >= 0) THEN 
    22592070    iret = NF90_REDEF(ncfid) 
    22602071  ENDIF 
    22612072!- 
    2262 ! 1.0 Do we have all dimensions and can we go ahead      
     2073! 1.0 Do we have all dimensions and can we go ahead 
    22632074!- 
    22642075  IF (check) THEN 
    2265     WRITE(*,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid)  
     2076    WRITE(*,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid) 
    22662077  ENDIF 
    22672078!- 
     
    22732084    ndim = ndim+1 
    22742085    xloc = 0 
    2275     DO ic=1,xax_nb(fid)  
     2086    DO ic=1,xax_nb(fid) 
    22762087      IF (xax_infs(fid,ic,1) == iim) xloc = ic 
    22772088    ENDDO 
     
    22942105    ndim = ndim+1 
    22952106    xloc = 0 
    2296     DO ic=1,yax_nb(fid)  
     2107    DO ic=1,yax_nb(fid) 
    22972108      IF (yax_infs(fid,ic,1) == jjm) xloc = ic 
    22982109    ENDDO 
     
    23152126    ndim = ndim+1 
    23162127    xloc = 0 
    2317     DO ic=1,zax_nb(fid)  
     2128    DO ic=1,zax_nb(fid) 
    23182129      IF (zax_infs(fid,ic,1) == llm) xloc = ic 
    23192130    ENDDO 
     
    23502161  ENDIF 
    23512162!- 
    2352 ! 3.0 Add the attributes if requested  
     2163! 3.0 Add the attributes if requested 
    23532164!- 
    23542165  IF (write_att) THEN 
     
    23682179 &                      'missing_value',REAL(missing_val,KIND=4)) 
    23692180!--- 
    2370     IF (itau_out(fid) >= 0) THEN  
     2181    IF (itau_out(fid) >= 0) THEN 
    23712182      iret = NF90_ENDDEF(ncfid) 
    23722183    ENDIF 
     
    23792190!---------------------- 
    23802191END SUBROUTINE restdefv 
    2381 !- 
    2382 !=== 
    2383 !- 
     2192!=== 
     2193SUBROUTINE rest_atim (l_msg,c_p) 
     2194!--------------------------------------------------------------------- 
     2195! Called by "c_p", [re]allocate the time axes 
     2196!--------------------------------------------------------------------- 
     2197  IMPLICIT NONE 
     2198!- 
     2199  LOGICAL,INTENT(IN) :: l_msg 
     2200  CHARACTER(LEN=*),INTENT(IN) :: c_p 
     2201!- 
     2202  INTEGER :: i_err,tszij 
     2203  INTEGER,ALLOCATABLE :: tmp_index(:,:) 
     2204  REAL,ALLOCATABLE :: tmp_julian(:,:) 
     2205!--------------------------------------------------------------------- 
     2206!- 
     2207!  Allocate the space we need for the time axes 
     2208!- 
     2209  IF (.NOT.ALLOCATED(t_index) .AND. .NOT.ALLOCATED(t_julian)) THEN 
     2210    IF (l_msg) THEN 
     2211      WRITE(*,*) TRIM(c_p)//' : Allocate times axes at :', & 
     2212 &               max_file,tax_size_in(nb_fi) 
     2213    ENDIF 
     2214!--- 
     2215    ALLOCATE(t_index(max_file,tax_size_in(nb_fi)),STAT=i_err) 
     2216    IF (i_err/=0) THEN 
     2217      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err 
     2218      CALL ipslerr (3,TRIM(c_p), & 
     2219 &      'Problem in allocation of t_index','', & 
     2220 &      '(you must increase memory)') 
     2221    ENDIF 
     2222    t_index (:,:) = 0 
     2223!--- 
     2224    ALLOCATE(t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err) 
     2225    IF (i_err/=0) THEN 
     2226      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err 
     2227      CALL ipslerr (3,TRIM(c_p), & 
     2228 &      'Problem in allocation of max_file,tax_size_in','', & 
     2229 &      '(you must increase memory)') 
     2230    ENDIF 
     2231    t_julian (:,:) = 0.0 
     2232  ELSE IF (    (SIZE(t_index,DIM=2)  < tax_size_in(nb_fi)) & 
     2233 &         .OR.(SIZE(t_julian,DIM=2) < tax_size_in(nb_fi)) ) THEN 
     2234    IF (l_msg) THEN 
     2235      WRITE(*,*) TRIM(c_p)//' : Reallocate times axes at :', & 
     2236 &               max_file,tax_size_in(nb_fi) 
     2237    ENDIF 
     2238!--- 
     2239    ALLOCATE (tmp_index(max_file,tax_size_in(nb_fi)),STAT=i_err) 
     2240    IF (i_err/=0) THEN 
     2241      WRITE(*,*) "ERROR IN ALLOCATION of tmp_index : ",i_err 
     2242      CALL ipslerr (3,TRIM(c_p), & 
     2243 &      'Problem in allocation of tmp_index','', & 
     2244 &      '(you must increase memory)') 
     2245    ENDIF 
     2246    tszij = SIZE(t_index,DIM=2) 
     2247    tmp_index(:,1:tszij) = t_index(:,1:tszij) 
     2248    DEALLOCATE(t_index) 
     2249    ALLOCATE (t_index(max_file,tax_size_in(nb_fi)),STAT=i_err) 
     2250    IF (i_err/=0) THEN 
     2251      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err 
     2252      CALL ipslerr (3,TRIM(c_p), & 
     2253 &     'Problem in reallocation of t_index','', & 
     2254 &     '(you must increase memory)') 
     2255    ENDIF 
     2256    t_index(:,1:tszij) = tmp_index(:,1:tszij) 
     2257!--- 
     2258    ALLOCATE (tmp_julian(max_file,tax_size_in(nb_fi)),STAT=i_err) 
     2259    IF (i_err/=0) THEN 
     2260      WRITE(*,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err 
     2261      CALL ipslerr (3,TRIM(c_p), & 
     2262 &     'Problem in allocation of tmp_julian','', & 
     2263 &     '(you must increase memory)') 
     2264    ENDIF 
     2265    tszij = SIZE(t_julian,DIM=2) 
     2266    tmp_julian(:,1:tszij) = t_julian(:,1:tszij) 
     2267    DEALLOCATE(t_julian) 
     2268    ALLOCATE (t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err) 
     2269    IF (i_err/=0) THEN 
     2270      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err 
     2271      CALL ipslerr (3,TRIM(c_p), & 
     2272 &      'Problem in reallocation of t_julian','', & 
     2273 &      '(you must increase memory)') 
     2274    ENDIF 
     2275    t_julian(:,1:tszij) = tmp_julian(:,1:tszij) 
     2276  ENDIF 
     2277!----------------------- 
     2278END SUBROUTINE rest_atim 
     2279!=== 
     2280SUBROUTINE rest_alloc (i_buff,i_qsz,l_msg,c_p) 
     2281!--------------------------------------------------------------------- 
     2282! Called by "c_p", allocate a temporary buffer 
     2283! (buff_tmp[1/2] depending on "i_buff" value) to the size "i_qsz". 
     2284!--------------------------------------------------------------------- 
     2285  IMPLICIT NONE 
     2286!- 
     2287  INTEGER,INTENT(IN) :: i_buff,i_qsz 
     2288  LOGICAL,INTENT(IN) :: l_msg 
     2289  CHARACTER(LEN=*),INTENT(IN) :: c_p 
     2290!- 
     2291  INTEGER :: i_bsz,i_err 
     2292  LOGICAL :: l_alloc1,l_alloc2 
     2293  CHARACTER(LEN=9) :: cbn 
     2294  CHARACTER(LEN=5) :: c_err 
     2295!--------------------------------------------------------------------- 
     2296  IF      (i_buff == 1) THEN 
     2297    IF (ALLOCATED(buff_tmp1)) THEN 
     2298      i_bsz = SIZE(buff_tmp1) 
     2299    ELSE 
     2300      i_bsz = 0 
     2301    ENDIF 
     2302    l_alloc1 =    (.NOT.ALLOCATED(buff_tmp1)) & 
     2303 &            .OR.((ALLOCATED(buff_tmp1)).AND.(i_qsz > i_bsz)) 
     2304    l_alloc2 = .FALSE. 
     2305    cbn = 'buff_tmp1' 
     2306  ELSE IF (i_buff == 2) THEN 
     2307    IF (ALLOCATED(buff_tmp2)) THEN 
     2308      i_bsz = SIZE(buff_tmp2) 
     2309    ELSE 
     2310      i_bsz = 0 
     2311    ENDIF 
     2312    l_alloc1 = .FALSE. 
     2313    l_alloc2 =    (.NOT.ALLOCATED(buff_tmp2)) & 
     2314 &            .OR.((ALLOCATED(buff_tmp2)).AND.(i_qsz > i_bsz)) 
     2315    cbn = 'buff_tmp2' 
     2316  ELSE 
     2317    CALL ipslerr (3,'rest_alloc', & 
     2318 &    'Called by '//TRIM(c_p),'with a wrong value of i_buff','') 
     2319  ENDIF 
     2320!- 
     2321!- 
     2322  IF (l_alloc1.OR.l_alloc2) THEN 
     2323    IF (l_msg) THEN 
     2324      IF (    (l_alloc1.AND.ALLOCATED(buff_tmp1)) & 
     2325 &        .OR.(l_alloc2.AND.ALLOCATED(buff_tmp2)) ) THEN 
     2326        WRITE(*,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz 
     2327      ELSE 
     2328        WRITE(*,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz 
     2329      ENDIF 
     2330    ENDIF 
     2331    IF (l_alloc1) THEN 
     2332      IF (ALLOCATED(buff_tmp1)) THEN 
     2333        DEALLOCATE(buff_tmp1) 
     2334      ENDIF 
     2335      ALLOCATE (buff_tmp1(i_qsz),STAT=i_err) 
     2336    ELSE 
     2337      IF (ALLOCATED(buff_tmp2)) THEN 
     2338        DEALLOCATE(buff_tmp2) 
     2339      ENDIF 
     2340      ALLOCATE (buff_tmp2(i_qsz),STAT=i_err) 
     2341    ENDIF 
     2342    IF (i_err /= 0) THEN 
     2343      WRITE (UNIT=c_err,FMT='(I5)') i_err 
     2344      CALL ipslerr (3,TRIM(c_p), & 
     2345 &      'Problem in allocation of',TRIM(cbn), & 
     2346 &      'Error : '//TRIM(c_err)//' (you must increase memory)') 
     2347    ENDIF 
     2348  ENDIF 
     2349!------------------------ 
     2350END SUBROUTINE rest_alloc 
     2351!=== 
    23842352SUBROUTINE ioconf_setatt (attname,value) 
    23852353!--------------------------------------------------------------------- 
     
    24062374!--------------------------- 
    24072375END SUBROUTINE ioconf_setatt 
    2408 !- 
    2409 !=== 
    2410 !- 
     2376!=== 
    24112377SUBROUTINE ioget_vdim (fid,vname_q,varnbdim_max,varnbdim,vardims) 
    24122378!--------------------------------------------------------------------- 
     
    24462412!------------------------ 
    24472413END SUBROUTINE ioget_vdim 
    2448 !- 
    2449 !=== 
    2450 !- 
     2414!=== 
    24512415SUBROUTINE ioget_vname (fid,nbvar,varnames) 
    24522416!--------------------------------------------------------------------- 
     
    24712435!------------------------- 
    24722436END SUBROUTINE ioget_vname 
    2473 !- 
    2474 !=== 
    2475 !- 
     2437!=== 
    24762438SUBROUTINE ioconf_expval (new_exp_val) 
    24772439!--------------------------------------------------------------------- 
     
    24962458!--------------------------- 
    24972459END SUBROUTINE ioconf_expval 
    2498 !- 
    2499 !=== 
    2500 !- 
     2460!=== 
    25012461SUBROUTINE ioget_expval (get_exp_val) 
    25022462!--------------------------------------------------------------------- 
     
    25122472!-------------------------- 
    25132473END SUBROUTINE ioget_expval 
    2514 !- 
    2515 !=== 
    2516 !- 
     2474!=== 
    25172475SUBROUTINE restclo (fid) 
    25182476!--------------------------------------------------------------------- 
     
    25432501      WRITE(*,*) & 
    25442502        'restclo : Closing specified restart file number :', & 
    2545         fid,netcdf_id(fid,1:2)  
     2503        fid,netcdf_id(fid,1:2) 
    25462504    ENDIF 
    25472505!--- 
    25482506    IF (netcdf_id(fid,1) > 0) THEN 
    25492507      iret = NF90_CLOSE(netcdf_id(fid,1)) 
    2550       IF (iret /= NF90_NOERR) THEN  
     2508      IF (iret /= NF90_NOERR) THEN 
    25512509        WRITE (n_e,'(I6)') iret 
    25522510        WRITE (n_f,'(I3)') netcdf_id(fid,1) 
     
    25622520    IF (netcdf_id(fid,2) > 0)  THEN 
    25632521      iret = NF90_CLOSE(netcdf_id(fid,2)) 
    2564       IF (iret /= NF90_NOERR) THEN  
     2522      IF (iret /= NF90_NOERR) THEN 
    25652523        WRITE (n_e,'(I6)') iret 
    25662524        WRITE (n_f,'(I3)') netcdf_id(fid,2) 
     
    25752533    IF (check) WRITE(*,*) 'restclo : Closing all files' 
    25762534!--- 
    2577     DO ifnc=1,nbfiles 
     2535    DO ifnc=1,nb_fi 
    25782536      IF (netcdf_id(ifnc,1) > 0) THEN 
    25792537        iret = NF90_CLOSE(netcdf_id(ifnc,1)) 
    2580         IF (iret /= NF90_NOERR) THEN  
     2538        IF (iret /= NF90_NOERR) THEN 
    25812539          WRITE (n_e,'(I6)') iret 
    25822540          WRITE (n_f,'(I3)') netcdf_id(ifnc,1) 
     
    25922550      IF (netcdf_id(ifnc,2) > 0) THEN 
    25932551        iret = NF90_CLOSE(netcdf_id(ifnc,2)) 
    2594         IF (iret /= NF90_NOERR) THEN  
     2552        IF (iret /= NF90_NOERR) THEN 
    25952553          WRITE (n_e,'(I6)') iret 
    25962554          WRITE (n_f,'(I3)') netcdf_id(ifnc,2) 
     
    26042562!--------------------- 
    26052563END SUBROUTINE restclo 
    2606 !- 
    2607 !=== 
    2608 !- 
     2564!=== 
     2565!----------------- 
    26092566END MODULE restcom 
Note: See TracChangeset for help on using the changeset viewer.