Changeset 3474 for IOIPSL


Ignore:
Timestamp:
11/20/17 14:26:40 (6 years ago)
Author:
jgipsl
Message:
  • Added exit in flinget if error when reading values from file
  • Added possiblilty to use netcdf compression in restcom. Option is activated by adding optional argument use_compression when calling restini

Modifications done by A. Jornet-Puig, LSCE

Location:
IOIPSL/trunk/src
Files:
2 edited

Legend:

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

    r1932 r3474  
    16131613             start=w_sta(:), count=w_len(:)) 
    16141614!--- 
     1615    IF (iret /= NF90_NOERR) THEN 
     1616        WRITE(ipslout,*) 'flinget_mat 2.9 : ',NF90_STRERROR (iret) 
     1617        CALL ipslerr(3, 'flinget_mat','Error on netcdf NF90_GET_VAR','', '') 
     1618    ENDIF 
     1619!--- 
    16151620    itau_len=itau_fin-itau_dep+1 
    16161621    IF (l_dbg) WRITE(ipslout,*) 'flinget_mat 3.0 : clen, itau_len ',clen,itau_len 
     
    16311636    iret = NF90_GET_VAR (fid, vid, var, & 
    16321637             start=w_sta(:), count=w_len(:)) 
    1633   ENDIF 
    1634 !- 
    1635   IF (l_dbg) WRITE(ipslout,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret) 
     1638 
     1639    IF (iret /= NF90_NOERR) THEN 
     1640        WRITE(ipslout,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret) 
     1641        CALL  ipslerr(3, 'flinget_mat','Error on netcdf NF90_GET_VAR','Read in netcdf failed', '') 
     1642    ENDIF 
     1643  ENDIF 
     1644!- 
     1645  IF (l_dbg) WRITE(ipslout,*) 'flinget_mat 3.2 : ',NF90_STRERROR (iret) 
    16361646!-------------------------- 
    16371647END  SUBROUTINE flinget_mat 
  • IOIPSL/trunk/src/restcom.f90

    r3374 r3474  
    167167  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp1,buff_tmp2 
    168168!- 
     169! Compression 
     170!- 
     171  LOGICAL,SAVE :: IS_COMPRESSION_ENABLED = .FALSE. 
     172!- 
    169173!=== 
    170174CONTAINS 
     
    173177SUBROUTINE restini & 
    174178 & (fnamein,iim,jjm,lon,lat,llm,lev, & 
    175  &  fnameout,itau,date0,dt,fid,owrite_time_in,domain_id ) 
     179 &  fnameout,itau,date0,dt,fid,owrite_time_in, & 
     180 &  domain_id,use_compression) 
    176181!--------------------------------------------------------------------- 
    177182!- This subroutine sets up all the restart process. 
     
    215220!- Optional INPUT arguments 
    216221!- 
    217 !- owrite_time_in : logical  argument which allows to 
    218 !-                  overwrite the time in the restart file 
    219 !- domain_id      : Domain identifier 
     222!- owrite_time_in  : logical  argument which allows to 
     223!-                   overwrite the time in the restart file 
     224!- use_compression : Enable netcdf compression 
     225!- domain_id       : Domain identifier 
    220226!- 
    221227!--------------------------------------------------------------------- 
     
    228234  LOGICAL,OPTIONAL :: owrite_time_in 
    229235  INTEGER,INTENT(IN),OPTIONAL :: domain_id 
     236  LOGICAL,OPTIONAL,INTENT(IN) :: use_compression 
    230237!- 
    231238  INTEGER :: ncfid 
     
    244251  ELSE 
    245252    overwrite_time = owrite_time_in 
     253  ENDIF 
     254!- 
     255  IS_COMPRESSION_ENABLED = .FALSE.  
     256  IF (PRESENT(use_compression) .AND. use_compression) THEN 
     257    IS_COMPRESSION_ENABLED = .TRUE. 
    246258  ENDIF 
    247259!- 
     
    881893  ENDDO 
    882894!- 
    883   iret = NF90_DEF_DIM(ncfid,'time',NF90_UNLIMITED,tdimid_out(fid)) 
     895  iret = NF90_DEF_DIM(ncfid,'time',1,tdimid_out(fid)) 
    884896!- 
    885897! 1.0 Longitude 
     
    17791791 &      .AND.(netcdf_id(fid,2) > 0) ) THEN 
    17801792!----- 
    1781       CALL restdefv (fid,vname_q,list_dims,.FALSE.) 
     1793      CALL restdefv (fid,vname_q,list_dims,.TRUE.) 
    17821794!----- 
    17831795      DO ia = 1,varatt_in(fid,vnb) 
     
    26912703    iret = NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), & 
    26922704 &                      'missing_value',REAL(missing_val,KIND=4)) 
     2705!--- 
     2706!   Compression 
     2707    IF (IS_COMPRESSION_ENABLED) THEN 
     2708      iret = NF90_DEF_VAR_DEFLATE(ncfid,varid_out(fid,nbvar_out(fid)),0,1,1) !DEFLATE_LEVEL_1 
     2709      IF (iret /= NF90_NOERR) CALL ipslerr (3,'restdefv', & 
     2710        'Could not add compression to new variable in file', & 
     2711        NF90_STRERROR(iret),varname) 
     2712    ENDIF 
    26932713!--- 
    26942714    IF (itau_out(fid) >= 0) THEN 
Note: See TracChangeset for help on using the changeset viewer.