w_th_surf_pload.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
 
!> \brief Writing TH/SURF tabs in restart file
!! \details  /PLOAD option
 
!||====================================================================
!||    w_th_surf_pload   ../starter/source/restart/ddsplit/w_th_surf_pload.F
!||--- called by ------------------------------------------------------
!||    ddsplit           ../starter/source/restart/ddsplit/ddsplit.F
!||--- calls      -----------------------------------------------------
!||--- uses       -----------------------------------------------------
!||    message_mod       ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE w_th_surf_pload(IBCL  ,NODLOCAL  ,PROC  ,LEN_IA  ,CEP    ,
     .                          TH_SURF,NUMNOD   ,NIBCLD ,NCONLD  ,LEN_CEP,
     .                          OFF    )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE my_alloc_mod
      USE th_surf_mod , ONLY : th_surf_
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER , INTENT(IN) :: NUMNOD   ,NIBCLD ,NCONLD   ,LEN_CEP  !< Parameters for size tables ( number of nodes,number of parameters in IBCL tab, number of pload, size of CEP)
      INTEGER , INTENT(IN) :: OFF               !< Index in table CEP
      INTEGER , INTENT(IN) :: PROC              !< Processor
      INTEGER , INTENT(INOUT) :: LEN_IA            !< Length of integer tables written in restart
      INTEGER , INTENT(IN) :: IBCL(NIBCLD,NCONLD)   !< list of segments where pressure /PLOAD is applied 
      INTEGER , INTENT(IN) :: NODLOCAL(NUMNOD)   !< table of local nodes
      INTEGER , INTENT(IN) :: CEP(LEN_CEP)          !< Proc to which belong the element
      TYPE (TH_SURF_) , INTENT(INOUT) :: TH_SURF !< Type for /TH/SURF and load pressures output tabs
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, NSEGP, NSEGPL, NL, NS, N4
      INTEGER, DIMENSION(:),ALLOCATABLE :: KSEGS_L, SEGS_L
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
 
C-----------------------------------------------
C         Writing TH/SURF tabs in restart file
C          /PLOAD option
C-----------------------------------------------
 
      CALL my_alloc(ksegs_l,th_surf%S_PLOAD_KSEGS)
      CALL my_alloc(segs_l,th_surf%S_PLOAD_SEGS)
      ksegs_l = 0
      segs_l = 0
      nsegp  = 0      
      nsegpl = 0
      DO i = 1, nconld
        n4 = ibcl(4,i)
        IF(n4/=-1) THEN
          nsegp = nsegp + 1
          IF(cep(i+off)==proc) THEN
            nsegpl = nsegpl + 1
            ns = th_surf%PLOAD_KSEGS (nsegp+1) - th_surf%PLOAD_KSEGS (nsegp)
            ksegs_l(nsegpl+1) =ksegs_l(nsegpl)+ ns
            DO j=1,ns
               segs_l(ksegs_l(nsegpl)+j)= th_surf%PLOAD_SEGS(th_surf%PLOAD_KSEGS (nsegp)+j)
            ENDDO
          ENDIF
        ENDIF
      ENDDO
 
      CALL write_i_c(nsegpl+1,1)
      CALL write_i_c(ksegs_l,nsegpl+1)
      CALL write_i_c(ksegs_l(nsegpl+1),1)
      CALL write_i_c(segs_l,ksegs_l(nsegpl+1))
      len_ia = len_ia + nsegpl+3+ ksegs_l(nsegpl+1)
 
      DEALLOCATE(ksegs_l,segs_l)
 
      RETURN
      END