psmile_smioc_finalize.F90

Go to the documentation of this file.

!------------------------------------------------------------------------
! Copyright 2006-2010, CERFACS, Toulouse, France.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
! BOP
!
! !ROUTINE: PSMILe_smioc_finalize
!
! !INTERFACE
subroutine psmile_smioc_finalize(id_error)

!
! !USES:
!
  USE PSMILe_smioc
!
  IMPLICIT NONE

!
! !PARAMETERS:
!

!
! ! RETURN VALUE
!
  INTEGER, INTENT (Out)               :: id_error   ! error value

! !DESCRIPTION
! Subroutine "PRISMDrv_finalize_smioc_struct" finalizeialize and set the driver
! smioc structures using the smioc api.
!
! !REVISED HISTORY
!   Date      Programmer   Description
! ----------  ----------   -----------
! 13/10/2003  S. Valcke     Creation
! 30/12/2003  D. Declat     Included in the driver
! 22/03/2010  JM Epitalon   Simultaneous access to multiple SMIOC files
!
! EOP
!----------------------------------------------------------------------
! $Id: psmile_smioc_finalize.F90 2399 2010-06-21 08:09:39Z coquart $
! $Author: coquart $
!----------------------------------------------------------------------
!
! 0. Local declarations
!
  CHARACTER(LEN=80), SAVE  :: mycvs = 
     '$Id'

!     ... for error handling
  INTEGER, PARAMETER  :: nerrp = 1
  INTEGER             :: ierrp (nerrp)
  INTEGER             :: id_err
!
!----------------------------------------------------------------------
!----------------------------------------------------------------------
!
  id_error = 0
  id_err = 0
!
! 1. Deallocation of global arrays
!
  DEALLOCATE(iga_comp_id_doc_XML, stat=id_err)
  DEALLOCATE(iga_comp_nb_grids, stat=id_err)
  DEALLOCATE(iga_comp_nb_transi, stat=id_err)
  DEALLOCATE(iga_comp_nb_persis, stat=id_err)
  DEALLOCATE(iga_comp_nb_unitsets, stat=id_err)
  DEALLOCATE(iga_smioc_unitsets, stat=id_err)
  DEALLOCATE(sga_smioc_grids, stat=id_err)
  DEALLOCATE(sga_smioc_transi, stat=id_err)
  DEALLOCATE(sga_smioc_persis, stat=id_err)
  DEALLOCATE(iga_comp_nb_stand_name, stat=id_err)
  DEALLOCATE(iga_comp_nb_transi_in, stat=id_err)
  DEALLOCATE(iga_comp_nb_transi_out, stat=id_err)

  IF (id_err > 0) THEN
      ierrp (1) = id_err
      id_err = 14
      
      call psmile_error ( id_err, 'PSMILe_smioc_finalize', &
         ierrp, 1, __FILE__, __LINE__ )
      RETURN
  ENDIF

  id_error = id_err

END SUBROUTINE PSMILe_smioc_finalize