psmile_open_file_byid.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2006-2010, SGI Germany, Munich, Germany.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PSMILE_Open_File_byid
!
! !INTERFACE:

      subroutine psmile_open_file_byid (id_varid,id_taskid,current_date,ierror)

!
! !USES:
!
      use PRISM_Constants
      use PSMILe_SMIOC, only : sga_smioc_transi
      use PSMILe, dummy_interface => PSMILE_Open_File_byid
      use PRISM_calendar
      use PSMILE_IO_UTILS
      implicit none
!
! !INPUT PARAMETERS:
!
      Integer, Intent (In)                 :: id_varid
      Integer, Intent (In)                 :: id_taskid
      Type(PRISM_Time_Struct),Intent (In)  :: current_date
!
! !OUTPUT PARAMETERS:
!

      Integer, Intent (Out)                :: ierror

!
! !LOCAL VARIABLES:
!
      integer                             :: ierrp(3)
      integer                             :: iicomp_id
      integer                             :: il_initial_date(6)
      integer                             :: il_filesize
      integer                             :: fullsize
      integer                             :: il_no_of_files,il_no,il_i,il_j
      integer                             :: il_natts,il_nvars,il_ntimes 
                                            ,il_ndims,iloc,il_grid_id
      integer                             :: il_axes(3)
      integer                             :: il_x,il_y
      integer                             :: il_smioc_loc,il_transiouts
      logical                             :: ll_exist,ll_base,ll_restart
      character(len=max_name)             :: cl_filename,cl_date 
                                            ,cl_time,cl_zone,cl_name,cl_uname
      character(len=4)                    :: cl_label
      character(len=max_name),allocatable :: cl_files_found(:)
      Type(IO_Data),Pointer               :: pl_io_info
      Type(PRISM_Time_Struct)             :: ljobstart
!
!
! !DESCRIPTION:
!
!  The routine opens files for reading or writing fields indentified by vard_id.
!  On output the file name is extended by _out_<current date>.
!  Moreover, if a file is already opened a check on the file size is performed
!  If the next output operation is about to exceed PSMILE_IO_MAX_FILE_SIZE
!  the current file is closed and a new one is opened. All global attributes
!  of the file are written here.
!  On input the routine detects whether a basename or a full file name
!  like 'foo.nc' was given. In case of a basename the routine performs
!  a search on files <basename_in_<date>.nc and tries to find a best match
!  for the current date. That scheme is used if a coupled model component
!  runs out of matching time stamps for a certain file during read operations.
!  If a full name was given the routine tries to open
!  the file name as given. For both scenarios a check is performed
!  if the current date can be matched with the time stamps contained
!  in an opened file.
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 05.11.03    R. Vogelsang created
! 09.12.03    R. Vogelsang added psmile_write_meta_byid and a description
! 23.3.04     R. Vogelsang Added the taskid to the interface and related code.
!
!EOP
!----------------------------------------------------------------------

       Character(len=len_cvs_string),save :: open_by_id= 
'$Id: psmile_open_file_byid.F90 2687 2010-10-28 15:15:52Z coquart $'

      ierror = 0
#ifdef __PSMILE_WITH_IO
#ifdef VERBOSE
      print*,trim(ch_id),' : PSMILe_open_file_byid: start'
      call psmile_flushstd
      print*,trim(ch_id),' : PSMILe_open_file_byid: date', current_date
      call psmile_flushstd

#endif
      if (.not.associated(Fields)) then

         ierror = PRISM_Error_Internal
         call psmile_error ( ierror, 'Fields not allocated ', &
                             ierrp, 0, __FILE__, __LINE__ )
      endif

      if ( (id_varid .gt. Size(Fields)).or.(id_varid.lt.1) .or. &
           (Fields(id_varid)%status .eq. PSMILe_Status_undefined) ) then

         ierror = PRISM_Error_Internal
         call psmile_error ( ierror, 'Fields(varid) status undefined ', &
                             ierrp, 0, __FILE__, __LINE__ )
      endif
      
      if (.not.associated(Fields(id_varid)%io_chan_infos)) then

         ierror = PRISM_Error_Internal
         call psmile_error ( ierror, 'Fields has no I/O infos! ', &
                             ierrp, 0, __FILE__, __LINE__ )
      endif

!
!     IO infos are pointing to io_chan_infos(taskid)
!
      if(id_taskid .le. size(Fields(id_varid)%io_task_lookup)) then

        il_i=Fields(id_varid)%io_task_lookup(id_taskid)

      else

        ierror = PRISM_Error_IO_Meta
        ierrp (1) = id_taskid
        call psmile_error ( ierror &
                          , 'Task id out of range! ', &
                            ierrp, 1, __FILE__, __LINE__ )
        return

      endif

      if (il_i.gt.0) then

         Fields(id_varid)%io_infos =>  Fields(id_varid)%io_chan_infos(il_i)

      else
        ierror = PRISM_Error_IO_Meta
        ierrp (1) = id_taskid
        call psmile_error ( ierror &
                          , 'Negative task id! ', &
                            ierrp, 1, __FILE__, __LINE__ )
        return
      endif

      pl_io_info => Fields(id_varid)%io_infos

!
!     Check if the taskid entered belongs to the range of 
!     ids related to restart files
!
      il_transiouts=0
      il_smioc_loc=Fields(id_varid)%smioc_loc

      if(associated(sga_smioc_transi(il_smioc_loc)%sga_transi_out)) &
           il_transiouts=size(sga_smioc_transi(il_smioc_loc)%sga_transi_out)
      if(id_taskid .gt. 0 ) then

         if(id_taskid.gt.2*il_transiouts+1 &
            .and.id_taskid.le.4*il_transiouts+1) then
           ll_restart=.true.
#ifdef VERBOSE
           print*,trim(ch_id),' : PSMILe_open_file_byid: Open of restart files!'
           call psmile_flushstd
#endif
         endif

      else

        ierror = PRISM_Error_IO_Meta
        ierrp (1) = id_taskid
        call psmile_error ( ierror &
                          , 'Task id out of range! ', &
                            ierrp, 1, __FILE__, __LINE__ )
      endif

      iicomp_id=Fields(id_varid)%comp_id

      if(.not.associated(IO_Comps_infos(iicomp_id)%pelist)) then
        ierror=PRISM_Error_IO_Domain
        ierrp(1)=iicomp_id
        call psmile_error ( ierror &
                         ,'pelist for component does not exist!' &
                         ,ierrp, 1, __FILE__,__LINE__)
      endif

      call mpp_set_current_pelist(IO_Comps_infos(iicomp_id)%pelist)


      Select Case(pl_io_info%action)

      Case (MPP_RDONLY)
#ifdef VERBOSE
          print*,trim(ch_id),' : PSMILe_open_file_byid: open for reading'
          call psmile_flushstd
#endif
!
!        For a GME grid return if the varid is not the first one of the
!        set of related  varids.
!
         if(associated(Fields(id_varid)%io_infos%related_ids)) then
           fullsize=size(Fields(id_varid)%io_infos%related_ids)
           if(fullsize.gt.1) then
             do il_i=1,fullsize
               if(id_varid.eq. Fields(id_varid)%io_infos%related_ids(il_i)) exit
             enddo
             if(il_i.gt.1) return
           endif
         endif

        If(len(trim(pl_io_info%filename)).eq.0) then
          ierror=PRISM_Error_IO_Open
          call psmile_error(ierror, &
              'No filename on read given!!!', &
                           ierrp,0, __FILE__, __LINE__)
        endif
!RV Implement here a sequence  which expands the basename of
!RV a file by an additional suffix showing the initial date of the time
!RV stamps contained in that file.
        call psmile_io_check_basename(trim(pl_io_info%filename),'.nc' &
                                     ,ll_base,ierror)
        If(ll_base) then
#ifdef VERBOSE
          print*,trim(ch_id),' : PSMILe_open_file_byid: basename given'
          call psmile_flushstd
#endif
!We have a basename. Build new file name basename_in.<date in ISO format>.nc
          il_initial_date(1)=current_date%year
          il_initial_date(2)=current_date%month
          il_initial_date(3)=current_date%day
          il_initial_date(4)=current_date%hour
          il_initial_date(5)=current_date%minute
          il_initial_date(6)=current_date%second
          call combine_with_date(pl_io_info%filename,'in' &
                                ,il_initial_date,cl_filename)
!
!         If the fileset is MPP_MULTI the MPP_IO package expects files
!         with the extension ...nc.0000 ...nc.0001 etc.
!
          if(pl_io_info%threading .eq. MPP_MULTI &
                                  .and.pl_io_info%fileset.EQ.MPP_MULTI) then
            write(cl_label,'(i4.4)') mpp_pe()
            cl_filename=trim(cl_filename)//'.'//trim(cl_label)
          endif

!
!How many files of the current directory do match the <basename>_in ?
!
#ifdef VERBOSE
          print*,trim(ch_id),' : PSMILe_open_file_byid: Looking for ' &
                ,trim(pl_io_info%filename)//'_in','*'
          call psmile_flushstd
#endif
          call psmile_io_scandir_no_of_files(trim(pl_io_info%filename)//'_in' &
                                             ,il_no_of_files,ierror)

          if(il_no_of_files.eq.0) then
            if(ll_restart) then
              ierror=PRISM_UNDEFINED
              ierrp(1) = 0
              call psmile_warning(ierror, &
                  'No match for basename '//trim(pl_io_info%filename)//'_in' &
                             ,ierrp, 1, __FILE__, __LINE__)
              return
            else
              ierror=PRISM_Error_IO_Open
              call psmile_error(ierror, &
                  'No match for basename '//trim(pl_io_info%filename)//'_in' &
                             ,ierrp,0, __FILE__, __LINE__)
            endif
          endif
!
!Get the matching file names alpha-numerically sorted in descending order.
!
          allocate(cl_files_found(1:il_no_of_files),stat=ierror)
          cl_files_found(1:il_no_of_files)=' '

          if(ierror.ne.0) then
            ierror=PRISM_Error_IO_Open
            call psmile_error(ierror, &
                'Allocation of file table failed!' &
                           ,ierrp,0, __FILE__, __LINE__)

          endif

          call psmile_io_scandir(trim(pl_io_info%filename)//'_in' &
                                ,cl_files_found,il_no_of_files &
                                ,il_no &
                                ,ierror)
!
!Try to find the matching file name!
!
#ifdef VERBOSE
          print*,trim(ch_id),' : PSMILe_open_file_byid: Trying to match ' &
                 ,' filename ',trim (cl_filename)
          call psmile_flushstd
#endif
          il_i=1
          do while(trim(cl_filename).lt.trim(cl_files_found(il_i))) 
             il_i=il_i+1
             if(il_i.gt.il_no_of_files) exit
          enddo

          if(il_i.gt.il_no_of_files) then
            if(ll_restart) then
              ierror=PRISM_UNDEFINED
              ierrp(1) = 0
              call psmile_warning(ierror, &
                  'Could not find a matching file for '//trim(cl_filename), &
                             ierrp, 1, __FILE__, __LINE__)
              return
            else
              ierror=PRISM_Error_IO_Open
              call psmile_error(ierror, &
                  'Could not find a matching file for '//trim(cl_filename), &
                             ierrp,0, __FILE__, __LINE__)
            endif
          endif
#ifdef VERBOSE
          print*,trim(ch_id),' : PSMILe_open_file_byid: Found best match for ' &
                ,' filename ',trim (cl_filename), ' as ' 
          print*, trim(cl_files_found(il_i))
          call psmile_flushstd
#endif

          do il_j=1,len(trim(cl_filename))
            cl_filename(il_j:il_j)=' '
          enddo

          cl_filename=trim(cl_files_found(il_i))
   

        else

!No basename. Use the filename as given!
          cl_filename=pl_io_info%filename

        endif

!
! Check here if the old input file is still opened!
!
!rv        Inquire(unit=pl_io_info%file_unit,opened=ll_exist)
        ll_exist=pl_io_info%opened
        if(.not.ll_base.and.ll_exist) then
!
!       The input file is supposed to be used as given. One can not open
!       it again.
!
          ierror=PRISM_Error_IO_Open
          call psmile_error(ierror, &
              'Attempt to open file '//trim(cl_filename)//' multiple times!', &
                           ierrp,0, __FILE__, __LINE__)

        else if(ll_base.and.ll_exist) then
          call psmile_close_file_byid(id_varid,id_taskid,ierror)
        endif

!
! Check here finally if the file really exists.
!
        Inquire(file=trim(cl_filename),exist=ll_exist)
        if(.not.ll_exist) then
          if(ll_restart) then
            ierror=PRISM_UNDEFINED
            ierrp(1) = 0
            call psmile_warning(ierror, &
                 'File '//trim(cl_filename)//' does not exist!', &
                              ierrp, 1, __FILE__, __LINE__)
            return
          else
            ierror=PRISM_Error_IO_Open
            call psmile_error(ierror, &
                 'File '//trim(cl_filename)//' does not exist!', &
                              ierrp,0, __FILE__, __LINE__)
          endif
        endif

!
!     Extract the label from the file name since mpp_open adds it automatically.
!
       if(pl_io_info%fileset .eq. MPP_MULTI) then
          cl_filename=cl_files_found(il_i)(1:len(trim(cl_files_found(il_i))) &
                       -len(trim(cl_label))-1)
        endif
#ifdef VERBOSE
        print*,trim(ch_id),' : PSMILe_open_file_byid: mpp_open:read: ' &
            ,id_varid,pl_io_info%file_unit,trim(cl_filename)
        call psmile_flushstd
#endif
        call mpp_open(pl_io_info%file_unit,trim(cl_filename) &
#ifdef __PARNETCDF
!rr                     ,mpp_comm=IO_Comps_infos(iicomp_id)%comm &
                        ,mpp_comm=IO_Apps_infos%comm &
#endif
                     ,action=pl_io_info%action &
                     ,form=pl_io_info%format &
                     ,threading=pl_io_info%threading &
                     ,fileset=pl_io_info%fileset)

        pl_io_info%opened=.true.

!     Get the basic informations: No. of dims, vars,atts and time stamps
!
      call mpp_get_info(pl_io_info%file_unit,il_ndims,il_nvars,il_natts &
                       ,il_ntimes)

#ifdef VERBOSE
        print*,trim(ch_id),' : PSMILe_open_file_byid: mpp_get_info: ' &
            ,il_ndims,il_nvars,il_natts,il_ntimes
        call psmile_flushstd
#endif
        if(il_ntimes.gt.0) then
          if(.not.associated(pl_io_info%p_mpp_io%atts) )  &
            allocate(pl_io_info%p_mpp_io%atts(il_natts),stat=ierror)
            if (ierror > 0) then
              ierrp (1) = ierror
              ierrp (2) = 1
              ierror = PRISM_Error_Alloc
              call psmile_error ( ierror, 'atts', &
                         ierrp, 2, __FILE__, __LINE__ )
              return
            endif


          if(.not.associated(pl_io_info%p_mpp_io%anaxis) ) &
            allocate(pl_io_info%p_mpp_io%anaxis(il_ndims),stat=ierror)
            if (ierror > 0) then
              ierrp (1) = ierror
              ierrp (2) = 1
              ierror = PRISM_Error_Alloc
              call psmile_error ( ierror, 'anaxis', &
                         ierrp, 2, __FILE__, __LINE__ )
              return
            endif

          if(.not.associated(pl_io_info%p_mpp_io%field) ) &
            allocate(pl_io_info%p_mpp_io%field(il_nvars),stat=ierror)
          if (ierror > 0) then
              ierrp (1) = ierror
              ierrp (2) = 1
              ierror = PRISM_Error_Alloc
              call psmile_error ( ierror, 'field', &
                         ierrp, 2, __FILE__, __LINE__ )
              return
          endif
          if(.not.associated(pl_io_info%p_cache) ) then

!RV
!RV         A quick hack: The max. number of transient input channels
!RV         per transient is set to 10!.
!RV
            if(.not.allocated(iocache)) then
              allocate(iocache(1:16*Number_of_Fields_allocated))
#ifdef PRISM_ASSERTION
              if(size(Fields(id_varid)%io_task_lookup) .gt. 16 ) then
              call psmile_assert (__FILE__, __LINE__, &
                                 "No. of I/O channels > 16")
              endif
#endif
              do il_i=1,16*Number_of_Fields_allocated
                Nullify(iocache(il_i)%time_stamps)
                Nullify(iocache(il_i)%data_dble)
                Nullify(iocache(il_i)%data_real)
                Nullify(iocache(il_i)%data_int)
              enddo

            endif

            pl_io_info%p_cache =>iocache(id_taskid+16*(id_varid-1))
            if(associated(pl_io_info%p_cache%time_stamps) ) then
              deallocate(pl_io_info%p_cache%time_stamps)
            endif

            allocate(pl_io_info%p_cache%time_stamps(0:il_ntimes),stat=ierror)
            pl_io_info%p_cache%llast=.false.
            pl_io_info%p_cache%ilast=0

            if(ierror > 0) then
              ierrp (1) = ierror
              ierrp (2) = 1
              ierror = PRISM_Error_Alloc
              call psmile_error ( ierror, 'time_stamps', &
                         ierrp, 2, __FILE__, __LINE__ )

            endif
          endif
        else
          ierror=PRISM_Error_IO_Open
          call psmile_error(ierror, &
              'File '//trim(cl_filename)//' does not contain time stamps!!!', &
                           ierrp,0, __FILE__, __LINE__)
        endif
!
!       Check if the file contains the requested variable !
!
        call mpp_get_fields(pl_io_info%file_unit,pl_io_info%p_mpp_io%field(:))
        iloc=0
        pl_io_info%p_mpp_io%findex=PRISM_Undefined

        il_i=len(trim(adjustl(Fields(id_varid)%io_infos%cfioname)))
        do il_j=1,il_nvars
          call mpp_get_atts(pl_io_info%p_mpp_io%field(il_j),name=cl_name  &
                           ,axes=pl_io_info%p_mpp_io%anaxis)
          if(cl_name(1:il_i).eq.Fields(id_varid)%io_infos%cfioname(1:il_i)) then
            iloc=iloc+1
            if(iloc.le.3) then
              pl_io_info%p_mpp_io%findex(iloc)=il_j
            else
              ierror=PRISM_Error_IO_Open
              call psmile_error(ierror, &
                 'Found more than 3 ocurences of '// &
                 trim(Fields(id_varid)%io_infos%cfioname), &
                           ierrp,0, __FILE__, __LINE__)

            endif
          endif
        enddo

        if(iloc.eq.0) then
           ierror=PRISM_Error_IO_Open
           call psmile_error(ierror, &
                 'The file '//trim(cl_filename)//' does not contain '// &
                 trim(Fields(id_varid)%io_infos%cfioname), &
                           ierrp,0, __FILE__, __LINE__)
        endif
!
!       Check if the lengths of the spatial axes matches the grid's
!       valid extents
!

        do il_j=1,il_nvars
          call mpp_get_atts(pl_io_info%p_mpp_io%field(il_j),name=cl_name  &
                           ,axes=pl_io_info%p_mpp_io%anaxis)
               if (trim(cl_name) .eq. Fields(id_varid)%local_name) exit
        enddo

        il_axes=PRISM_Undefined
        do il_j=1,il_ndims
          call mpp_get_atts(pl_io_info%p_mpp_io%anaxis(il_j),name=cl_name &
                           ,len=il_axes(1))
          if(trim(cl_name).eq.'X') exit
          if(trim(cl_name).eq.'x') exit
        enddo
#ifdef VERBOSE
      print*,trim(ch_id),' : PSMILe_open_file_byid:read: ' &
            ,'Length of x-axis ',il_axes(1)
      call psmile_flushstd
#endif

        do il_j=1,il_ndims
          call mpp_get_atts(pl_io_info%p_mpp_io%anaxis(il_j),name=cl_name &
                           ,len=il_axes(2))
          if(trim(cl_name).eq.'Y') exit
          if(trim(cl_name).eq.'y') exit
        enddo

#ifdef VERBOSE
      print*,trim(ch_id),' : PSMILe_open_file_byid:read: ' &
            ,'Length of y-axis ',il_axes(2)
      call psmile_flushstd
#endif
        do il_j=1,il_ndims
          call mpp_get_atts(pl_io_info%p_mpp_io%anaxis(il_j),name=cl_name &
                           ,len=il_axes(3))
          if(trim(cl_name).eq.'Z') exit
          if(trim(cl_name).eq.'z') exit
        enddo

#ifdef VERBOSE
      print*,trim(ch_id),' : PSMILe_open_file_byid:read: ' &
            ,'Length of z-axis ',il_axes(3)
      call psmile_flushstd
#endif

        il_grid_id=Methods(Fields(id_varid)%method_id)%grid_id

        do il_j=1,Grids(il_grid_id)%n_dim

!rv,sgi   I am leaving the original (?) statement as a reminder!          
!rv,sgi   if(pl_io_info%threading .eq. MPP_MULTI &
!rv,sgi                           .and.pl_io_info%fileset.EQ.MPP_SINGLE) then
          if(pl_io_info%fileset.EQ.MPP_SINGLE) then
            if(il_j.le.2) then
              call mpp_get_global_domain(pl_io_info%p_mpp_io%domain(1) &
                                       ,xsize=il_x,ysize=il_y)
#ifdef VERBOSE
              print*,trim(ch_id),' : PSMILe_open_file_byid:read: ' &
                    ,'Extents of domain ',il_x,il_y
              call psmile_flushstd
#endif
              if(il_j.eq.1) il_i=il_x
              if(il_j.eq.2) il_i=il_y
            else
              il_i=Grids(il_grid_id)%grid_shape(2,il_j)- & 
                   Grids(il_grid_id)%grid_shape(1,il_j)+1
            endif

          else
            il_i=Grids(il_grid_id)%grid_shape(2,il_j)- & 
               Grids(il_grid_id)%grid_shape(1,il_j)+1
          endif

          if(il_i.ne.il_axes(il_j)) then

           ierror=PRISM_Error_IO_Open

           ierrp(1)=il_j
           ierrp(2)=il_i
           ierrp(3)=il_axes(il_j)
           call psmile_error(ierror, &
                 'The size of a axis does not match grids valid extent!'//  &
                 trim(Fields(id_varid)%io_infos%cfioname), &
                           ierrp,3, __FILE__, __LINE__)
          endif
        enddo
!
!       At this point it seems that we have right file with the correct
!       field. Get the time stamps
!
        call mpp_get_times(pl_io_info%file_unit &
                          ,pl_io_info%p_cache%time_stamps(1:il_ntimes))
#ifdef VERBOSE
        print*,trim(ch_id),' : PSMILe_open_file_byid:read: time stamp(1) = ' &
              ,pl_io_info%p_cache%time_stamps(1),' time stamp(',il_ntimes,') ='&
              ,pl_io_info%p_cache%time_stamps(il_ntimes)
        call psmile_flushstd
#endif
!
!       Extract the job start date from the units of the time axis
!
        
        do il_j=1,il_ndims
          call mpp_get_atts(pl_io_info%p_mpp_io%anaxis(il_j),name=cl_name &
                           ,units=cl_uname)
          if(trim(cl_name).eq.'time' .or. &
             trim(cl_name).eq.'TIME' .or. &
             trim(cl_name).eq.'Time') exit
        enddo

        if(il_j.gt.il_ndims) then
           ierror=PRISM_Error_IO_Open
           call psmile_error(ierror, &
                 'The file '//trim(cl_filename)//' contains '// &
                 ' non CF compliant identifier for time.', &
                           ierrp,0, __FILE__, __LINE__)
        endif

        call extract_date(cl_uname,ljobstart)
#ifdef VERBOSE
        print*,trim(ch_id),' : PSMILe_open_file_byid:read: extracted date = ' &
              ,trim(cl_uname), ljobstart
        call psmile_flushstd
#endif
        call psmile_date2ju(ljobstart,pl_io_info%ju_start_day &
                           ,pl_io_info%ju_start_sec)


!
!      File opened and ready to be read !
!     
        
      Case (MPP_OVERWR)
!
!        For a GME grid return if the varid is not the last one of the
!        set of related  varids.
!
         if(associated(Fields(id_varid)%io_infos%related_ids)) then
           fullsize=size(Fields(id_varid)%io_infos%related_ids)
           if(fullsize.gt.1) then
             do il_i=1,fullsize
               if(id_varid.eq. Fields(id_varid)%io_infos%related_ids(il_i)) exit
             enddo
             if(il_i.lt.fullsize) return
           endif
         endif

!
!        Try to estimate the potential filesize after the next IO operation.
!
         il_filesize=2*pl_io_info%current_filesize-pl_io_info%old_filesize
         

!
!        The initial open
!
         if((il_filesize.le.0).and.(.not.pl_io_info%opened))then
!
!        Get date and time to fill the global history attribute
!
         call date_and_time(DATE=cl_date,TIME=cl_time,ZONE=cl_zone)
         cl_date='Date of creation: '//trim(cl_date)//' '//trim(cl_time) &
                //' '//trim(cl_zone)
!
!        No basename given. Try to construct one.
!
           If(len(trim(pl_io_info%filename)).eq.0) then
             pl_io_info%filename=trim( Fields(id_varid)%local_name)//'.nc'
           endif
!
!          Initial date is Gregorian.
!
           if(pl_io_info%isuffix.eq.PSMILe_true) then
             il_initial_date(1)=current_date%year
             il_initial_date(2)=current_date%month
             il_initial_date(3)=current_date%day
             il_initial_date(4)=current_date%hour
             il_initial_date(5)=current_date%minute
             il_initial_date(6)=current_date%second
             call combine_with_date(pl_io_info%filename,'out' &
                                   ,il_initial_date,cl_filename)
           else
             cl_filename=trim(adjustl(pl_io_info%filename))
           endif

#ifdef VERBOSE
      print*,trim(ch_id),' : PSMILe_open_file_byid: mpp_open:write: ' &
            ,id_varid,pl_io_info%file_unit,trim(cl_filename),il_filesize
      call psmile_flushstd
#endif
           call mpp_open(pl_io_info%file_unit,trim(cl_filename) &
#ifdef __PARNETCDF
!rr                     ,mpp_comm=IO_Comps_infos(iicomp_id)%comm &
                        ,mpp_comm=IO_Apps_infos%comm &
#endif
                        ,action=pl_io_info%action &
                        ,form=pl_io_info%format &
                        ,threading=pl_io_info%threading &
                        ,fileset=pl_io_info%fileset)

           call mpp_write_meta(pl_io_info%file_unit &
                              ,'Conventions' &
                              ,cval='CF-1.0')
           call mpp_write_meta(pl_io_info%file_unit &
                         ,'institution' &
                         ,cval='PRISM')
           call mpp_write_meta(pl_io_info%file_unit &
                         ,'source' &
                         ,cval=trim(Comps(Fields(id_varid)%comp_id)%comp_name))
           call mpp_write_meta(pl_io_info%file_unit &
                         ,'history' &
                         ,cval=trim(cl_date))
           pl_io_info%opened=.true.


         else if(il_filesize.ge.PSMILE_IO_MAX_FILE_SIZE) then
!
!        Get date and time to fill the global history attribute
!
         call date_and_time(DATE=cl_date,TIME=cl_time,ZONE=cl_zone)
         cl_date='Date of creation: '//trim(cl_date)//' '//trim(cl_time) &
                //' '//trim(cl_zone)

!RV      Close the current file and open a new one with the
!RV      same basename but with a second suffix identifying the current date

           call psmile_close_file_byid(id_varid,id_taskid,ierror)
  
           il_initial_date(1)=current_date%year
           il_initial_date(2)=current_date%month
           il_initial_date(3)=current_date%day
           il_initial_date(4)=current_date%hour
           il_initial_date(5)=current_date%minute
           il_initial_date(6)=current_date%second
           call combine_with_date(pl_io_info%filename, 'out' &
                                 ,il_initial_date,cl_filename)
#ifdef VERBOSE
      print*,trim(ch_id),' : PSMILe_open_file_byid: mpp_open:reopen,write: ' &
            ,id_varid,pl_io_info%file_unit,trim(cl_filename),il_filesize
      call psmile_flushstd
#endif
           call mpp_open(pl_io_info%file_unit,trim(cl_filename) &
#ifdef __PARNETCDF
!rr                     ,mpp_comm=IO_Comps_infos(iicomp_id)%comm &
                        ,mpp_comm=IO_Apps_infos%comm &
#endif
                        ,action=pl_io_info%action &
                        ,form=pl_io_info%format &
                        ,threading=pl_io_info%threading &
                        ,fileset=pl_io_info%fileset)
           call mpp_write_meta(pl_io_info%file_unit &
                              ,'Conventions' &
                              ,cval='CF-1.0')
           call mpp_write_meta(pl_io_info%file_unit &
                         ,'institution' &
                         ,cval='PRISM')
           call mpp_write_meta(pl_io_info%file_unit &
                         ,'Source' &
                         ,cval=trim(Comps(Fields(id_varid)%comp_id)%comp_name))
           call mpp_write_meta(pl_io_info%file_unit &
                         ,'history' &
                         ,cval=trim(cl_date))
!
!          Rewrite the axis, variable attributes and variable  data.
!          Rewrite field declarations.
!
           call psmile_write_meta_byid(id_varid,id_taskid,ierror)

           pl_io_info%current_filesize=0
           pl_io_info%opened=.true.
         

         else
#ifdef VERBOSE
          print*,trim(ch_id),' : PSMILe_open_file_byid: Estimated file size ' &
                ,'of ',trim(pl_io_info%filename) &
                ,'is ',il_filesize,' kB'
          call psmile_flushstd
#endif
         endif
      Case DEFAULT

         ierror=PRISM_Error_IO_Open
         ierrp(1)=pl_io_info%action
         ierrp(2)=MPP_RDONLY
         ierrp(3)=MPP_OVERWR
         call psmile_error(ierror,'Wrong action on file taken!', &
                           ierrp,3, __FILE__, __LINE__)

      End Select
#ifdef VERBOSE
      print*,trim(ch_id),' : PSMILe_open_file_byid: end'
      call psmile_flushstd
#endif
#endif
      

      end subroutine PSMILe_open_file_byid