prismdrv_create_transi_udef.F90

Go to the documentation of this file.

!------------------------------------------------------------------------
! Copyright 2006, CERFACS, Toulouse, France.
! All rights reserved. Use is subject to license terms.
!------------------------------------------------------------------------
!BOP
! !INTERFACE
  SUBROUTINE prismdrv_create_transi_udef ( id_nb_transi,     &
                                  id_xml,           &
                                  id_u,             &
                                  id_ch,            &
                                  id_side,          &
                                  sda_smioc_transi, &
                                  id_comp,          &
                                  id_error )
!
    USE psmile_smioc
    USE psmile_smioc_interface
    IMPLICIT NONE
!
!EOP
!----------------------------------------------------------------------
! $Id: psmile_smioc.F90 1793 2008-11-25 14:58:31Z valcke $
! $Author: valcke $
!----------------------------------------------------------------------
!
! !INPUT / OUTPUT PARAMETERS:

!   Dimensions of array sda_smioc_transi (2nd pass)
    Integer, Intent(In)          :: id_nb_transi

!   Index of transient (geographic) to be copied (defined in the SMIOC XML)
    Integer, Intent(In)          :: id_xml

!   Index of associated transient "udef" to be created for this component
    Integer, Intent(In)          :: id_u

!   Index of channel (In OR Out) of the SMIOC XML (geographic) transient
    Integer, Intent(In)          :: id_ch

!   Side of channel (In) only .XOR. (Out) only of the id_ch channel
    Integer, Intent(In)          :: id_side

!   transients structure (array allocated with dimension id_nb_transi in second pass)
    TYPE(transient), Dimension(id_nb_transi), TARGET,  Intent(InOut)  ::  sda_smioc_transi
!
!   Index of component 
    Integer, Intent(In)          :: id_comp

!   returned error code
    Integer, Intent(Out)         :: id_error
!
! Global structure sga_comp_udef_idx is used to detect which input origin
! transient or which output transient uses a User-Defined Interpolation :
! in flag : sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%lga_trin_orig(ib_nin)
! out flag : sga_comp_udef_idx(ib_c)%sla_driver_udef(ib)%lga_trout(ib_nout)
!
! !LOCAL VARIABLES
!   Loop indices
    Integer :: ib_tr, ib_st, ib_o, ib_i, ib_c
    Integer :: il_nb_stand_name
    Integer :: il_nb_in_orig
    Integer :: il_nb_transi_out
!
!   Local pointers on transients "input" (from)  and destination
    TYPE(transient), pointer :: ti, td
!
!   character buffers
    Character(len=max_name)  :: cl_in,  cl_out   
!
!   parameter for channel bypass in suffix
    Integer, parameter  :: il_cc = -1

! !DESCRIPTION
! This routine copies the id_xml transient structure into the id_u transient 
! Only non-modified parts are copied
! Modifed parts (character names) are new variables created in this routine
! The associated transient do not take part in interpolation.
!
! !REVISION HISTORY:
!   Date        Programmer     Description
! ----------    ----------     -----------
! 18/11/2009      Latour        Creation
!
!EOP
!-----------------------------------------------------------------------
!
!  Define pointers
   ti => sda_smioc_transi(id_xml)
   td => sda_smioc_transi(id_u)

!  Transient level variables
!
   il_nb_stand_name = ti%ig_nb_stand_name 
!
   td%ig_nb_stand_name = il_nb_stand_name
!  td%ig_comp_id       = ti%ig_comp_id
!  td%ig_transi_id     = ti%ig_transi_id
   td%ig_transi_type   = ti%ig_transi_type
   td%ig_nb_bndl       = ti%ig_nb_bndl
   td%ig_datatype      = ti%ig_datatype

!  Add suffixe "_gl" to names
!  Transient local name
    cl_in = ti%cg_local_name   
    call put_udef_suffix ( cl_in, cl_out, id_ch, id_side )
    td%cg_local_name = trim(adjustl(cl_out))
!
   td%cg_long_name     = ti%cg_long_name
   td%cg_comp_name     = ti%cg_comp_name
   td%cg_units         = ti%cg_units
!
!  Transient standard names : NO change ( array dimension = ig_nb_stand_name )
    DO ib_st = 1, il_nb_stand_name
       td%cga_stand_name(ib_st) = ti%cga_stand_name(ib_st)
    ENDDO
!
!!     ti%dg_transi_min   NOT copied
!!     ti%dg_transi_max   NOT copied
!
!   Gridless transient_in for a channel IN in the geographic transient
    IF ( id_side == 1 ) THEN

!      Gridless transient has only 1 Input or Output channel
       td%sg_transi_in%ig_nb_in_orig      = 1
!
       td%sg_transi_in%ig_exch_date_type  = ti%sg_transi_in%ig_exch_date_type
       td%sg_transi_in%ig_debugmode       = ti%sg_transi_in%ig_debugmode
       td%sg_transi_in%ig_tgt_timeop      = ti%sg_transi_in%ig_tgt_timeop
       td%sg_transi_in%iga_stats          = ti%sg_transi_in%iga_stats
       td%sg_transi_in%sg_min_period      = ti%sg_transi_in%sg_min_period
       td%sg_transi_in%sg_tgt_local_trans = ti%sg_transi_in%sg_tgt_local_trans
       td%sg_transi_in%sg_exch_date       = ti%sg_transi_in%sg_exch_date
!
!  Transient_in origin  is the origin number of the "XML" transient
!  Global component id is id_comp
       ib_i = id_ch
!       td%sg_transi_in%sga_in_orig(1)%ig_transi_in_id   =  &
!       ti%sg_transi_in%sga_in_orig(ib_i)%ig_transi_in_id

       td%sg_transi_in%sga_in_orig(1)%ig_orig_type      =  &
       ti%sg_transi_in%sga_in_orig(ib_i)%ig_orig_type

#ifdef DEBUG
  print *,' ig_orig_type geographique = ',ti%sg_transi_in%sga_in_orig(ib_i)%ig_orig_type
  print *,' ig_orig_type gridless = ',td%sg_transi_in%sga_in_orig(1)%ig_orig_type
#endif
!       td%sg_transi_in%sga_in_orig(1)%ig_orig_transi_id =  &
!       ti%sg_transi_in%sga_in_orig(ib_i)%ig_orig_transi_id

       td%sg_transi_in%sga_in_orig(1)%ig_orig_comp_id   =  &
       ti%sg_transi_in%sga_in_orig(ib_i)%ig_orig_comp_id 
 
       td%sg_transi_in%sga_in_orig(1)%ig_conserv        =  &
       ti%sg_transi_in%sga_in_orig(ib_i)%ig_conserv

!  Transient_in names in the origin component : add suffix with I and ch number

       cl_in = ti%sg_transi_in%sga_in_orig(ib_i)%cg_transi_in_name
       call put_udef_suffix ( cl_in, cl_out, il_cc, il_cc  )
       td%sg_transi_in%sga_in_orig(1)%cg_transi_in_name = trim(adjustl(cl_out))
! 
       cl_in = ti%sg_transi_in%sga_in_orig(ib_i)%cg_orig_transi
       call put_udef_suffix ( cl_in, cl_out, il_cc, il_cc  )
       td%sg_transi_in%sga_in_orig(1)%cg_orig_transi    = trim(adjustl(cl_out))
!
       td%sg_transi_in%sga_in_orig(1)%cg_orig_comp_name =  &
       ti%sg_transi_in%sga_in_orig(ib_i)%cg_orig_comp_name
!
       td%sg_transi_in%sga_in_orig(1)%sg_orig_file =  &
       ti%sg_transi_in%sga_in_orig(ib_i)%sg_orig_file
!
       td%sg_transi_in%sga_in_orig(1)%sg_cpl_rst_file   =  &
       ti%sg_transi_in%sga_in_orig(ib_i)%sg_cpl_rst_file
!       
!  Interpolation structure is NOT copied in the gridless auxilliary transient
#ifdef DEBUG
   print *,' ig_interp_type geographique = ',   &
             ti%sg_transi_in%sga_in_orig(ib_i)%sg_interp%ig_interp_type
#endif

!
       td%sg_transi_in%sga_in_orig(1)%sg_combi          =  &
       ti%sg_transi_in%sga_in_orig(ib_i)%sg_combi

    ENDIF
!
!   Gridless transient_out for a channel OUT in the geographic transient
    IF ( id_side == 0 ) THEN

!      Gridless transient has only 1 Input or Output channel
       td%ig_nb_transi_out = 1
       ib_o = id_ch
!  
!       td%sga_transi_out(1)%ig_transi_out_id  =  &
!       ti%sga_transi_out(ib_o)%ig_transi_out_id
!
       td%sga_transi_out(1)%ig_dest_type      =  &
       ti%sga_transi_out(ib_o)%ig_dest_type
!
!       td%sga_transi_out(1)%ig_dest_transi_id =  &
!       ti%sga_transi_out(ib_o)%ig_dest_transi_id
!
       td%sga_transi_out(1)%ig_dest_comp_id   =  &
       ti%sga_transi_out(ib_o)%ig_dest_comp_id
!
       td%sga_transi_out(1)%ig_exch_date_type =  &
       ti%sga_transi_out(ib_o)%ig_exch_date_type
!
       td%sga_transi_out(1)%ig_debugmode      =  &
       ti%sga_transi_out(ib_o)%ig_debugmode
!
       td%sga_transi_out(1)%ig_lag            =  &
       ti%sga_transi_out(ib_o)%ig_lag
!
       td%sga_transi_out(1)%ig_src_timeop     =  &
       ti%sga_transi_out(ib_o)%ig_src_timeop
!
       td%sga_transi_out(1)%ig_conserv        =  &
       ti%sga_transi_out(ib_o)%ig_conserv
!
       td%sga_transi_out(1)%iga_stats         =  &
       ti%sga_transi_out(ib_o)%iga_stats
!
       cl_in = ti%sga_transi_out(ib_o)%cg_transi_out_name
       call put_udef_suffix ( cl_in, cl_out, il_cc, il_cc )
       td%sga_transi_out(1)%cg_transi_out_name = trim(adjustl(cl_out))
!
       cl_in = ti%sga_transi_out(ib_o)%cg_dest_transi
       call put_udef_suffix ( cl_in, cl_out, il_cc, il_cc  )
       td%sga_transi_out(1)%cg_dest_transi = trim(adjustl(cl_out))
!
       td%sga_transi_out(1)%cg_dest_comp_name =  &
       ti%sga_transi_out(ib_o)%cg_dest_comp_name
!
       td%sga_transi_out(1)%sg_dest_file       =  &
       ti%sga_transi_out(ib_o)%sg_dest_file
!
       td%sga_transi_out(1)%sg_cpl_rst_file    =  &
       ti%sga_transi_out(ib_o)%sg_cpl_rst_file
!
       td%sga_transi_out(1)%sg_min_period      =  &
       ti%sga_transi_out(ib_o)%sg_min_period
!
       td%sga_transi_out(1)%sg_exch_date       =  &
       ti%sga_transi_out(ib_o)%sg_exch_date
!
       td%sga_transi_out(1)%sg_src_local_trans =  &
       ti%sga_transi_out(ib_o)%sg_src_local_trans
!
       td%sga_transi_out(1)%sg_combi           =  &
       ti%sga_transi_out(ib_o)%sg_combi

    ENDIF
!
    Nullify ( ti )
    Nullify ( td )

    id_error = 0
 
    RETURN

  END SUBROUTINE prismdrv_create_transi_udef
!
!-----------------------------------------------------------------------