prism_info.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2006-2011, MPI-Met, Hamburg, Germany
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE: PRISM_Abort
00008 !
00009 ! !INTERFACE:
00010 !
00011 subroutine prism_info ( info, mesg )
00012 !
00013 ! !USES:
00014 !
00015   use PRISM , dummy_interface => prism_info
00016   use PSMILe, only : psmile_flushstd, ch_id, len_cvs_string
00017 !
00018   implicit none
00019 !
00020 ! !INPUT PARAMETERS:
00021 !
00022   Integer, Intent(In)       :: info
00023 
00024 !     PRISM info code
00025 !
00026 ! !OUTPUT PARAMETERS:
00027 !
00028       Character(len=PRISM_MAX_info_string), Intent(Out) :: mesg
00029 !
00030 !     Text corresponding to the incoming info code
00031 !
00032 ! !Local Variables
00033 !
00034       Integer               :: my_info
00035 ! !DESCRIPTION:
00036 !
00037 !     Returns meaning of info parameter
00038 !
00039 ! !REVISION HISTORY:
00040 
00041 !   Date      Programmer   Description
00042 ! ----------  ----------   -----------
00043 ! 01.12.03      H. Ritzdorf  created
00044 !
00045 !EOP
00046 !----------------------------------------------------------------------
00047 !
00048 ! $Id: prism_abort.F90 2939 2011-02-03 12:13:10Z redler $
00049 ! $Author:$
00050 !
00051   Character(len=len_cvs_string), save :: mycvs = 
00052       '$Id:$'
00053 
00054 #ifdef VERBOSE
00055   print 9990, trim(ch_id)
00056   call psmile_flushstd
00057 #endif /* VERBOSE */
00058 
00059   mesg = 'Event: Coupling o | IO o | Restart o | Time Operation o'
00060 
00061   my_info = info
00062 
00063   if ( my_info >= 1000 ) then
00064      mesg(17:17) = 'x'
00065      my_info = my_info - 1000
00066   endif
00067 
00068   if ( my_info >= 100  ) then
00069      mesg(24:24) = 'x'
00070      my_info = my_info - 100
00071   endif
00072 
00073   if ( my_info >= 10 ) then
00074      mesg(36:36) = 'x'
00075      my_info = my_info - 10
00076   endif
00077 
00078   if ( my_info == 1 ) then
00079      mesg(55:55) = 'x'
00080   endif
00081 
00082 #ifdef VERBOSE
00083   print 9970, trim(ch_id), trim(mesg)
00084   print 9980, trim(ch_id)
00085 
00086   call psmile_flushstd
00087 #endif /* VERBOSE */
00088 
00089 9970 format (1x, a, ': prism_info: ', a)
00090 9990 format (1x, a, ': prism_info: ')
00091 9980 format (1x, a, ': prism_info: eof')
00092 
00093 end subroutine prism_info