prism_terminate.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2007-2010, CERFACS, Toulouse, France.
00003 ! Copyright 2007-2010, SGI Germany, Munich, Germany.
00004 ! Copyright 2007-2010, NEC Europe Ltd., London, UK.
00005 ! All rights reserved. Use is subject to OASIS4 license terms.
00006 !-----------------------------------------------------------------------
00007 !BOP
00008 !
00009 ! !ROUTINE: PRISM_Terminate
00010 !
00011 ! !INTERFACE:
00012 
00013       subroutine prism_terminate ( ierror )
00014 !
00015 ! !USES:
00016 !
00017       use PRISM, dummy_interface => prism_terminate
00018 !
00019       use PSMILe
00020 !
00021       use psmile_timer, only : psmile_timer_stop, psmile_timer_print
00022 
00023       implicit none
00024 !
00025 ! !OUTPUT PARAMETERS:
00026 !
00027       integer, intent (out)               :: ierror
00028 !
00029 !     Returns the error code of prism_init;
00030 !             ierror = 0 : No error
00031 !             ierror > 0 : Severe error
00032 !
00033 ! !LOCAL VARIABLES
00034 !
00035       integer, parameter :: nerrp = 1
00036 
00037       logical            :: flag
00038       integer            :: ierrp (nerrp)
00039 
00040 !
00041 ! !DESCRIPTION:
00042 !
00043 !   Subroutine prism_terminate finalizes the environment of the PRISM
00044 !   coupler (PSMILe library and I/O library).
00045 !
00046 !   Collective call. Termination of PRISM application. All open files are
00047 !   closed. MPI_Finalize is called. This function will close the
00048 !   PSMILe. This should trigger the closure of all communications, files
00049 !   and save in a restart files all variables for which the processing is
00050 !   not finished.
00051 !
00052 ! !SEE ALSO:
00053 !
00054 !   prism_terminated, prism_init, prism_initialized
00055 !
00056 ! !REVISION HISTORY:
00057 !
00058 !   Date      Programmer   Description
00059 ! ----------  ----------   -----------
00060 ! 01.12.03    R. Redler    created
00061 !
00062 !EOP
00063 !----------------------------------------------------------------------
00064 !
00065 ! $Id: prism_terminate.F90 2849 2011-01-05 08:14:13Z hanke $
00066 ! $Author: hanke $
00067 !
00068   Character(len=len_cvs_string), save :: mycvs = 
00069       '$Id: prism_terminate.F90 2849 2011-01-05 08:14:13Z hanke $'
00070 !
00071 !----------------------------------------------------------------------
00072 #ifdef VERBOSE
00073       print *, trim(ch_id), ': prism_terminate: start'
00074       call psmile_flushstd
00075 #endif /* VERBOSE */
00076 
00077       ierror = 0
00078 #ifdef __PSMILE_WITH_IO
00079 !
00080 ! Finalize PSMILe I/O library
00081 !
00082       call psmile_io_finalize (ierror)
00083 #endif
00084 
00085 !  Finalize timers
00086 
00087 #ifdef PROFILE
00088       call psmile_timer_stop(1)
00089       call psmile_timer_print
00090 #endif
00091 !
00092 ! Finalize MPI environment if necessary
00093 !
00094 #ifdef PRISM_with_MPI1
00095 #ifdef VERBOSE
00096       print *, trim(ch_id), ': prism_terminate: PRISM_with_MPI1'
00097       call psmile_flushstd
00098 #endif /* VERBOSE */
00099       flag = .false.
00100 #else
00101 #ifdef VERBOSE
00102       print *, trim(ch_id), ': prism_terminate: not PRISM_with_MPI1'
00103       call psmile_flushstd
00104 #endif /* VERBOSE */
00105       call MPI_Finalized ( flag, ierror )
00106 #endif
00107 
00108       if ( ierror /= MPI_SUCCESS ) then
00109          ierrp (1) = ierror
00110          ierror = PRISM_Error_Initialized
00111 
00112          call psmile_error ( ierror, 'MPI_Finalized', &
00113                              ierrp, nerrp, __FILE__, __LINE__ )
00114          return
00115       endif
00116 
00117       if ( .not. flag ) then
00118          if ( MPI_was_initialized ) then
00119 
00120             call MPI_Barrier(Appl%comm, ierror)
00121 
00122             if (.not. Appl%stand_alone) call psmile_trs_finalize(PRISMdrv_root, ierror)
00123 
00124             call MPI_Finalize ( ierror )
00125 
00126             if ( ierror /= MPI_SUCCESS ) then
00127                ierrp (1) = ierror
00128                ierror = PRISM_Error_MPI
00129                call psmile_error ( ierror, 'MPI_Finalize', &
00130                                    ierrp, nerrp,  __FILE__, __LINE__ )
00131                return
00132             endif
00133 
00134             print *, trim(ch_id), ': -------------------------------------'
00135             print *, trim(ch_id), ': --- Note: MPI_Finalize was called ---'
00136             print *, trim(ch_id), ': ---       from prism_terminate.   ---'
00137             print *, trim(ch_id), ': -------------------------------------'
00138             call psmile_flushstd
00139 
00140          else
00141 
00142             print *, trim(ch_id), ': --------------------------------------------'
00143             print *, trim(ch_id), ': --- Warning: MPI_Finalize is expected to ---'
00144             print *, trim(ch_id), ': ---          be called from application. ---'
00145             print *, trim(ch_id), ': --------------------------------------------'
00146             call psmile_flushstd
00147 
00148          endif
00149       endif
00150 
00151 ! Clean up memory
00152 
00153       call psmile_deallocate ( ierror )
00154 
00155       PRISM_is_terminated  = .true.
00156 
00157       end subroutine prism_terminate