psmile_print_field_info.F90

Go to the documentation of this file.
00001 !
00002 !-----------------------------------------------------------------------
00003 ! Copyright 2006-2010, NEC Europe Ltd., London, UK.
00004 ! All rights reserved. Use is subject to OASIS4 license terms.
00005 !-----------------------------------------------------------------------
00006 !BOP
00007 !
00008 ! !ROUTINE: PSMILe_Print_field_info
00009 !
00010 ! !INTERFACE:
00011 
00012       subroutine psmile_print_field_info (field_id)
00013 !
00014 ! !USES:
00015 !
00016       use PRISM_constants
00017       use PSMILe, dummy_interface => PSMILe_Print_field_info
00018 
00019       implicit none
00020 !
00021 ! !INPUT PARAMETERS:
00022 !
00023       integer,Intent(In)  :: field_id
00024 
00025 !     Handle to the field information to be printed.
00026 !
00027 ! !LOCAL VARIABLES
00028 !
00029      character(len=22), save :: name_status (PSMILe_Status_free: 
00030                                              PSMILe_Status_commited)
00031      character(len=22), save :: name_type (PRISM_Character: 
00032                                            PRISM_Double_Quad)
00033 !    character(len=22), save :: name_scatter (PSMILe_scat: &
00034 !                                             PSMILe_gath)
00035 
00036      data name_status /'PSMILe_Status_free', 'PSMILe_status_defined', &
00037                        'PSMILe_Status_commited'/
00038 
00039      data name_type / 'PRISM_Character'       , 'PRISM_Integer',        &
00040                       'PRISM_Logical'         , 'PRISM_Real',           &
00041                       'PRISM_Double_Precision', 'PRISM_Complex',        &
00042                       'PRISM_Double_Complex'  , 'PRISM_Quad_Precision', &
00043                       'PRISM_Double_Quad'/
00044 
00045 !    data name_scatter / 'PSMILe_gath', 'PSMILe_scat'/
00046 
00047 !
00048 ! !DESCRIPTION:
00049 !
00050 ! Subroutine "PSMILe_Print_field_info" prints the info of a field handle.
00051 !
00052 !
00053 ! !REVISION HISTORY:
00054 !
00055 !   Date      Programmer    Description
00056 ! ----------  -----------   -----------
00057 ! 01.12.03    H. Ritzdorf   created
00058 !
00059 !EOP
00060 !----------------------------------------------------------------------
00061 !
00062 ! $Id: psmile_print_field_info.F90 2755 2010-11-19 15:19:52Z hanke $
00063 ! $Author: hanke $
00064 !
00065    Character(len=len_cvs_string), save :: mycvs = 
00066        '$Id: psmile_print_field_info.F90 2755 2010-11-19 15:19:52Z hanke $'
00067 !
00068 !----------------------------------------------------------------------
00069 !
00070       write (*, 9000) trim(ch_id), field_id
00071 !
00072 !  Check
00073 !
00074       if (field_id > Number_of_Fields_allocated .or. &
00075           field_id < 1) then
00076 
00077          write (*, 9010) 'Is an invalid field id.'
00078 
00079          call psmile_flushstd ()
00080          return
00081       endif
00082 !
00083 ! Status
00084 !
00085       if (Fields(field_id)%status == PSMILe_status_free) then
00086          write (*, 9010) 'Is currently free.'
00087 
00088          call psmile_flushstd ()
00089          return
00090       endif
00091 !
00092       if (Fields(field_id)%status >= PSMILe_Status_free .and. &
00093           Fields(field_id)%status <= PSMILe_status_commited) then
00094           write (*, 9020) 'status             ', Fields(field_id)%status, &
00095                           name_status (Fields(field_id)%status)
00096       else
00097           write (*, 9020) 'status             ', Fields(field_id)%status
00098       endif
00099 !
00100 ! Global field Id
00101 !
00102       write (*, 9020) 'global var_id      ', Fields(field_id)%global_var_id
00103 !
00104 ! Data Type
00105 !
00106       if (Fields(field_id)%dataType >= PRISM_Character .and. &
00107           Fields(field_id)%dataType <= PRISM_Double_Quad) then
00108           write (*, 9020) 'data type          ', Fields(field_id)%dataType, &
00109                           name_type (Fields(field_id)%dataType)
00110       else
00111           write (*, 9020) 'unknown data type  ', Fields(field_id)%status
00112       endif
00113 !
00114 !  Print general info
00115 !
00116       write (*, 9020) 'grid_id                ', Methods(Fields(field_id)%method_id)%grid_id
00117       write (*, 9020) 'comp_id                ', Fields(field_id)%comp_id
00118       write (*, 9020) 'method_id              ', Fields(field_id)%method_id
00119       write (*, 9020) 'mask_id                ', Fields(field_id)%mask_id
00120 
00121       write (*, 9020) 'size                   ', Fields(field_id)%size
00122 
00123       write (*, 9030) 'local name             ', trim(adjustl(Fields(field_id)%local_name))
00124 !
00125 !  FLush output
00126 !
00127       write (*, 9010)
00128 
00129       call psmile_flushstd ()
00130 !
00131 !-----------------------------------------------------------------------
00132 !  Formats
00133 !-----------------------------------------------------------------------
00134 !
00135 9000  format (/1x, a, ': Info on field handle', i3, ':', &
00136               /1x, 40('-'))
00137 9010  format (1x, a)
00138 9020  format (1x, a30, ' = ', i7, : 1x, a)
00139 9030  format (1x, a30, 3x,    a)
00140 !
00141       end subroutine PSMILe_Print_field_info