put_udef_suffix.F90

Go to the documentation of this file.
00001 !------------------------------------------------------------------------
00002 ! Copyright 2006, CERFACS, Toulouse, France.
00003 ! All rights reserved. Use is subject to license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007   SUBROUTINE put_udef_suffix ( cd_in, cd_out, id_chan, id_side )
00008 !
00009    USE PRISM_Constants
00010    USE PSMILe_Common
00011    IMPLICIT NONE 
00012 !
00013 ! !REVISED HISTORY
00014 !   Date        Programmer     Description
00015 ! ----------    ----------     -----------
00016 ! 20/10/2003    S. Valcke      Creation
00017 ! 30/12/2003    D. Declat      Implemented as a module
00018 !
00019 !EOP
00020 !----------------------------------------------------------------------
00021 ! $Id: psmile_smioc.F90 1793 2008-11-25 14:58:31Z valcke $
00022 ! $Author: valcke $
00023 !----------------------------------------------------------------------
00024 !
00025 
00026 ! !Input  argument
00027    Character(len=*),        Intent(In)  :: cd_in
00028 
00029 ! !Output argument
00030    Character(len=max_name), Intent(Out) :: cd_out
00031 !
00032 ! !Input argument
00033    Integer,                  Intent(In) :: id_chan
00034 !
00035 ! !Input argument : 0 = source = "O",       1 = target = "I"
00036    Integer,                  Intent(In) :: id_side
00037 !
00038 ! !Local variables
00039    Integer                  :: lenbuf
00040    Character(len=max_name)  :: cl_buffer
00041    Character(len=2)         :: cl_chid
00042    Character(len=2)         :: cl_ios
00043 !
00044 !  Convert integer channel number "id_chan" into 2 characters variable "cl_chid"
00045    if ( id_chan == -1 ) then
00046       cl_chid = '  '
00047    else
00048       write ( UNIT=cl_chid, FMT='(I2.2)' ) id_chan
00049    endif
00050 !
00051    if ( id_side == -1 ) then
00052       cl_ios = '_C'
00053    else
00054 !  Channel side is mandatory for "local names" in associated gridless transients
00055       IF ( id_side == 0 ) cl_ios = 'O_'
00056       IF ( id_side == 1 ) cl_ios = 'I_'
00057    endif
00058 !
00059    cl_buffer = ' '
00060    cl_buffer = trim(adjustl(cd_in))
00061    lenbuf = len_trim(cl_buffer)
00062    cd_out = cl_buffer(1:lenbuf)//'_gl'//cl_ios//cl_chid
00063    cd_out = trim(adjustl(cd_out))
00064 
00065    RETURN
00066 
00067   END SUBROUTINE put_udef_suffix
00068 !
00069 !-----------------------------------------------------------------------