prismdrv_get_all_transi.F90

Go to the documentation of this file.

  SUBROUTINE prismdrv_get_all_transi ( id_nb_transi,       &
                                       sda_smioc_transi,   &
                                       id_comp,            &
                                       id_error )

! !DESCRIPTION

! Called from prismdrv_init_smioc_struct for the second pass only 
! This routine creates all "User-defined" associated gridless transients 
! for each input or output channel that uses a "user3D" interpolation method
!
!----------------------------------------------------------------------
!

! !PUBLIC TYPES
  USE PRISM_Constants
  USE PSMILe_Common
  USE PSMILe_smioc
  USE PSMILE_smioc_interface

  IMPLICIT NONE

! 0. Declaration
!
! number of transi variables
    INTEGER, INTENT(In) :: id_nb_transi

! transi structure
    TYPE(transient), DIMENSION(id_nb_transi), INTENT(InOut) :: sda_smioc_transi

! Component id
    INTEGER, INTENT(In) :: id_comp

! returned error code
    INTEGER, INTENT(Out):: id_error

! Loop indices
    INTEGER :: ib, ib_bis, ib_nt, ib_xml, ib_xmlv, ib_xud
    INTEGER :: il_nb, il_nb_bis, il_nb_ter, il_nb_terbis, il_nb_terter
    INTEGER :: il_nb_qua, il_nb_cin, il_nb_six, il_nb_hep, il_nb_oct
    INTEGER :: il_nb_bisbis
    INTEGER :: il_xml_transi
    INTEGER :: il_dim_i, il_dim_o, il_ch, il_side
!
!  At second pass (called from prismdrv_init_smioc_struct) :
!  id_nb_transi = total number of transients including "udef" transients

    il_xml_transi = id_nb_transi - iga_comp_nb_udef(id_comp)

#ifdef DEBUG
    print *,"get_transi_details : il_xml_transi    = ", il_xml_transi
    print *,"get_transi_details : il_xml_transi    = ", iga_xml_comp_nb_transi(id_comp)
    print *,"get_transi_details : id_nb_transi     = ", id_nb_transi
    print *,"get_transi_details : nb udef transi   = ", iga_comp_nb_udef(id_comp)
#endif
!
!   Return if NO transient with "user3D" interpolation
!
    if ( iga_comp_nb_udef(id_comp) == 0 ) RETURN

!   Second pass only : copy of transients involved with User_defined Interp
!                      into new "gridless" transients.
!                      All names are changed with the suffix "_ud_X"
!                      Interp. method is left "undef" in the "gridless" transients
!
!   Before entering this subroutine, transient data extracted from XML in first pass
!   is copied into the array sla_driver_transi(1:il_xml_transi)
!   (No need to read the XML SMIOC files a second time)

!   Create structures for the "gridless" transients
!   ib is "global index in component" of the "gridless" additional transients
!      ib values are from il_xml_transi + 1  to id_nb_transi
!
!   Loop on the sga_comp_udef_idx(id_comp)%ig_xml_udef  XML_udef transients
    ib = il_xml_transi
       DO ib_xud = 1, sga_comp_udef_idx(id_comp)%ig_xml_udef

!   copy of the (geographic) transient structure into 1 or more "gridless" trans.

!   Note that for 1 geographic transient, we can have several "gridless" auxilliary
!   transients : 1 for each input origin, or output with user3D interpolation
!   "gl" transient index ib is therefore increased in the loop before each copy.

!   Simple copy of structures with pointers has for consequentce that
!   any modification in the copy affects ALSO the original
!   i.e. : sda_smioc_transi(ib) = sda_smioc_transi(ib_xml) is forbidden here.
!   Only the non-modified parts of the structure can be copied
!   interpolation structures are not copied (left "undefined")
!   modifed names (add suffix "_ug_XX") are created ; XX is the channel number

!   ib_xml is the index of the transient in component SMIOC file to be copied
    ib_xml = sga_comp_udef_idx(id_comp)%iga_trans_udef(ib_xud)
#ifdef DEBUG
   print *, ' get_transi_details : ib, ib_xud, ib_xml = ', ib, ib_xud, ib_xml
#endif

!   Get real number of channels of ib_xml transient (In  "AND / OR"  Out)
    il_dim_i = sga_comp_udef_idx(id_comp)%sla_driver_udef(ib_xml)%ig_dim_orig
    il_dim_o = sga_comp_udef_idx(id_comp)%sla_driver_udef(ib_xml)%ig_dim_out

    IF ( il_dim_i .GT. 0 )  THEN

!   Transient In to be copied  (target side)
      DO il_ch = 1, il_dim_i
         IF ( sga_comp_udef_idx(id_comp)%sla_driver_udef(ib_xml)%  &
                    lga_trin_orig(il_ch) ) THEN
#ifdef DEBUG
   print *, ' get_transi_details : In,  ib_xml il_ch ib = ', ib_xml, il_ch, ib
#endif
            ib = ib + 1
            IF ( ib .GT. id_nb_transi ) THEN
               PRINT *, '****************************************************'
               PRINT *, 'Index overflow in psmile_smioc : get_transi_details '
               PRINT *, '****************************************************'
               CALL PSMILe_Flushstd
               CALL MPI_Abort(MPI_COMM_WORLD, 1, id_error)
            ENDIF
!    Internal check on the value of ib_xml
            ib_xmlv = sga_comp_udef_idx(id_comp)%iga_xml_trindex(ib-il_xml_transi)
            IF ( ib_xmlv .NE. ib_xml ) THEN
               PRINT *, '*************************************************'
               PRINT *, 'Index error in psmile_smioc : get_transi_details '
               PRINT *, '*************************************************'
               CALL PSMILe_Flushstd
               CALL MPI_Abort(MPI_COMM_WORLD, 1, id_error)
             ENDIF
!    Create gridless transient structures
                 il_side = 1
                 call prismdrv_create_transi_udef ( id_nb_transi,      &
                                           ib_xml,            &
                                           ib,                &
                                           il_ch,             &
                                           il_side,           &
                                           sda_smioc_transi,  &
                                           id_comp,           &
                                           id_error )
          ENDIF        ! channel is "udef"
        ENDDO       ! loop on all input channels
      ENDIF      ! il_dim_i > 0
!
!
      IF ( il_dim_o .GT. 0 )  THEN
        DO il_ch = 1, il_dim_o
          IF ( sga_comp_udef_idx(id_comp)%sla_driver_udef(ib_xml)%  &
                    lga_trout(il_ch) ) THEN
#ifdef DEBUG
   print *, ' get_transi_details : Out, ib_xml il_ch ib = ', ib_xml, il_ch, ib
#endif
            ib = ib + 1
            IF ( ib .GT. id_nb_transi ) THEN
               PRINT *, '****************************************************'
               PRINT *, 'Index overflow in psmile_smioc : get_transi_details '
               PRINT *, '****************************************************'
               CALL PSMILe_Flushstd
               CALL MPI_Abort(MPI_COMM_WORLD, 1, id_error)
            ENDIF
!    Internal check on the value of ib_xml
            ib_xmlv = sga_comp_udef_idx(id_comp)%iga_xml_trindex(ib-il_xml_transi)
            IF ( ib_xmlv .NE. ib_xml ) THEN
               PRINT *, '*************************************************'
               PRINT *, 'Index error in psmile_smioc : get_transi_details '
               PRINT *, '*************************************************'
               CALL PSMILe_Flushstd
               CALL MPI_Abort(MPI_COMM_WORLD, 1, id_error)
             ENDIF
!    Create gridless transient structures
                 il_side = 0
                 call prismdrv_create_transi_udef ( id_nb_transi,      &
                                           ib_xml,            &
                                           ib,                &
                                           il_ch,             &
                                           il_side,           &
                                           sda_smioc_transi,  &
                                           id_comp,           &
                                           id_error )
          ENDIF      ! channel is "udef"
       ENDDO       ! loop on all output channels
     ENDIF      ! il_dim_o > 0
!
     ENDDO            !  loop on "xml udef" transients to be copied

!
  END SUBROUTINE prismdrv_get_all_transi