prism_get_inquire.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2006-2010, MPI-Met, Hamburg, Germany
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE: PRISM_get_inquire
00008 !
00009 ! !INTERFACE:
00010 
00011 subroutine prism_get_inquire ( field_id, info, ierror )
00012 !
00013 ! !USES:
00014 !
00015   use PRISM, dummy_interface => prism_get_inquire
00016   use PSMILe
00017   use PSMILe_SMIOC, only : sga_smioc_comp, transient
00018 
00019   implicit none
00020 !
00021 ! !INPUT PARAMETERS:
00022 !
00023   Integer, Intent (In)                 :: field_id
00024 
00025 !     Handle to the variable information
00026 !
00027 ! !OUTPUT PARAMETERS:
00028 !
00029   Integer, Intent (Out)               :: info
00030 
00031 !     returned info about action performed
00032 
00033   Integer, Intent (Out)               :: ierror
00034 
00035 !     Returns the error code of prism_get_inquire;
00036 !             ierror = 0 : No error
00037 !             ierror > 0 : Severe error
00038 !
00039 ! !LOCAL VARIABLES
00040 !
00041   Type (GridFunction), Pointer :: fp
00042   Type (transient), Pointer    :: sga_smioc_transi(:)
00043 
00044   Integer                      :: nb_transi_in
00045 !
00046 ! !DESCRIPTION:
00047 !
00048 !  Subroutine "prism_get_inquire" returns information about
00049 !          whether the field is generally available either from
00050 !          file or via coupling from a remote application.
00051 !          It does not test for a particular date because this
00052 !          is done by prism_get. Thus prism_get may only be called
00053 !          if prism_get_inquire has once returned an info different
00054 !          form PRISM_NOACTION.
00055 !
00056 ! !REVISION HISTORY:
00057 !   Date      Programmer   Description
00058 ! ----------  ----------   -----------
00059 ! 10.10.14    R. Redler    created
00060 !
00061 !EOP
00062 !----------------------------------------------------------------------
00063 !
00064 ! $Id$
00065 ! $Author$
00066 !
00067   Character(len=len_cvs_string), save :: mycvs = 
00068       '$Id$'
00069 !
00070 !----------------------------------------------------------------------
00071 
00072 #ifdef VERBOSE
00073    print *, trim(ch_id), ': prism_get_inquire: field_id', field_id
00074    call psmile_flushstd
00075 #endif /* VERBOSE */
00076 
00077 !----------------------------------------------------------------------
00078 !  1st Initialization
00079 !----------------------------------------------------------------------
00080 
00081    ierror          = 0
00082    info            = PRISM_NOACTION
00083 
00084 !----------------------------------------------------------------------
00085 !  2nd Check field_id
00086 !----------------------------------------------------------------------
00087 
00088    if ( Fields(field_id)%status /= PSMILe_status_defined ) then
00089 
00090       ierror = PRISM_Error_Arg
00091 
00092       print *, trim(ch_id), ': prism_get_inquire: eof field_id not defined'
00093       call psmile_flushstd
00094 
00095       return
00096 
00097    endif
00098 
00099    fp               => Fields(field_id)
00100    sga_smioc_transi => sga_smioc_comp(Fields(field_id)%comp_id)%sga_smioc_transi
00101 
00102 !-----------------------------------------------------------------------
00103 ! 3rd Return in case the field is not defined
00104 !-----------------------------------------------------------------------
00105 
00106    if ( fp%smioc_loc == PRISM_UNDEFINED ) then
00107       ierror = PRISM_Error_Arg
00108       print *, trim(ch_id), ': prism_get_inquire: WARNING: smioc_loc undefined'
00109       call psmile_flushstd
00110 #ifdef VERBOSE
00111       print *, trim(ch_id), ': prism_get_inquire: eof ', ierror
00112       call psmile_flushstd
00113 #endif /* VERBOSE */
00114       return
00115    endif
00116 
00117 !-----------------------------------------------------------------------
00118 ! 4th Return in case the field is not used
00119 !-----------------------------------------------------------------------
00120 
00121    nb_transi_in = fp%Taskin%nbr_inchannels
00122 
00123    if ( nb_transi_in < 1 ) then
00124 #ifdef VERBOSE
00125       print *, trim(ch_id), ': prism_get_inquire: eof ig_nb_transi_in ', nb_transi_in
00126       call psmile_flushstd
00127 #endif /* VERBOSE */
00128       return
00129    endif
00130 
00131    if ( .not. fp%used_for_coupling .and. &
00132         .not. fp%used_for_io ) then
00133 #ifdef VERBOSE
00134       print *, trim(ch_id), ': prism_get: nothing to do'
00135       print *, trim(ch_id), ': prism_get: eof ierror ', ierror
00136       call psmile_flushstd
00137 #endif /* VERBOSE */
00138       return
00139    endif
00140 
00141 !-----------------------------------------------------------------------
00142 ! 5th Return appropriate info in case the field is used
00143 !-----------------------------------------------------------------------
00144 
00145    if ( fp%used_for_coupling ) info = info + 1000
00146    if ( fp%used_for_io )       info = info + 100
00147 
00148 #ifdef VERBOSE
00149    print *, trim(ch_id), ': prism_get_inquire: eof ierror ', ierror
00150    call psmile_flushstd
00151 #endif /* VERBOSE */
00152 
00153 end subroutine prism_get_inquire