psmile_check_restart.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_Check_Restart
!
! !INTERFACE:

      subroutine  psmile_check_restart(id_varid,id_taskid,id_info,ierror)

!
! !USES:
!
      use PRISM_Constants
      use PSMILe_SMIOC, only : sga_smioc_transi
      use PSMILe, dummy_interface => PSMILE_Check_Restart
      use PRISM_calendar
      use psmile_io_utils
      implicit none
!
! !INPUT PARAMETERS:
!
      Integer, Intent (In)                 :: id_varid
      Integer, Intent (In)                 :: id_taskid
!
! !OUTPUT PARAMETERS:
!

      Integer, Intent (Out)                 :: id_info
      Integer, Intent (Out)                :: ierror

!
! !LOCAL VARIABLES:
!
      integer                             :: ierrp(3)
      integer                             :: il_taskid_restr
      integer                             :: il_smioc_loc,il_transiouts
      integer                             :: il_i
      Type(IO_Data),Pointer               :: pl_io_info
      Type(PRISM_Time_Struct)             :: current_date
      integer,dimension(6)        :: il_date
!
!
! !DESCRIPTION:
!
! The routine interfaces the routine psmile_open_restart_file_byid
! which attempts to open a restart file.   
! If the open of a restart file is successful the routine
! returns for id_info a value larger than zero. Otherwise that value
! is zero.

!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 23.8.04     R. Vogelsang Created
!
!EOP
!----------------------------------------------------------------------

       Character(len=len_cvs_string),save :: check_restart= 
'$Id: psmile_check_restart.F90 2325 2010-04-21 15:00:07Z valcke $'

      ierror = 0
      id_info= 0
#ifdef __PSMILE_WITH_IO
#ifdef VERBOSE
      print*,trim(ch_id),' : psmile_check_restart: start'
      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
      
!
!     Shift task id into the range of task ids for reading a restart!
!
      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

         il_taskid_restr=2*il_transiouts+id_taskid +1

      else

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

      if(il_taskid_restr .le. size(Fields(id_varid)%io_task_lookup)) then

        il_i=Fields(id_varid)%io_task_lookup(il_taskid_restr)

      else
        ierror = PRISM_Error_IO_Meta
        ierrp (1) = il_taskid_restr
        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

!
!     Check open status of the potential restart file.
!
      id_info=0

!
!     If a restart file was opened we have a restart.
!
      if ( Fields(id_varid)%io_infos%opened ) id_info=1

#ifdef VERBOSE

      if (id_info .gt. 0 ) then
         print*,trim(ch_id),' : psmile_check_restart: Restart from file ' &
               ,trim( Fields(id_varid)%io_infos%filename),' is possible!'
         call psmile_flushstd
      else
         print*,trim(ch_id),' : psmile_check_restart: Restart from file ' &
               ,trim( Fields(id_varid)%io_infos%filename), ' is not possible!'
      endif

      print*,trim(ch_id),' : psmile_check_restart: end'
      call psmile_flushstd

#endif
#endif
      

      end subroutine PSMILe_check_restart