user_windows_tools.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/.
!||====================================================================
!||    set_user_window_nodes   ../starter/source/user_interface/user_windows_tools.F
!||--- calls      -----------------------------------------------------
!||    userwis_front           ../starter/source/user_interface/user_windows_tools.F
!||    usr2sys                 ../starter/source/system/sysfus.F
!||--- uses       -----------------------------------------------------
!||    message_mod             ../starter/share/message_module/message_mod.F
!||    restmod                 ../starter/share/modules1/restart_mod.F
!||    user_interface_mod      ../starter/source/modules/user_interface_mod.F90
!||====================================================================
      SUBROUTINE set_user_window_nodes(USERNODS,NUMBER_USERNODS)
!$COMMENT
   ! -----------------------------------------------
   !   ROUTINE DESCRIPTION :
   !   ===================
   !   Callback routine for User Windows
   !   Grabs the Nodes from the UserWindows for Storing 
   !   and Sets them to Domain 1
   ! ------------------------------------------------
   !   DUMMY ARGUMENTS DESCRIPTION:
   !   ===================
   !
   !     NAME          DESCRIPTION                         
   !
   !     USERNODS          Array with User nodes
   !     NUMBER_USERNODS   Array size
   !------------------------------------------------------------------
!$ENDCOMMENT
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE my_alloc_mod
      USE message_mod
      USE user_windows_mod
      USE user_interface_mod
      USE restmod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NUMBER_USERNODS
      INTEGER, INTENT(IN),DIMENSION(NUMBER_USERNODS) :: USERNODS
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NOD,INTERNAL_NOD,USERWI_ID
      INTEGER,DIMENSION(:),ALLOCATABLE::WORK,USER_NDS,IDX,SORT
      CHARACTER(len=40) ::  MESS
      DATA mess/'USER WINDOWS '/
C-----------------------------------------------
      INTEGER USR2SYS
      EXTERNAL usr2sys
      
      userwi_id = user_windows%USER_WINDOWS_ID
      user_windows%N_USERNODS = number_usernods
      
      CALL my_alloc(user_nds,number_usernods)
      CALL my_alloc(user_windows%USERNODS,number_usernods)
      
      !print*,'NUMBER_USERNODS=',NUMBER_USERNODS
      !print*,'USERNDS=',USERNODS(1:NUMBER_USERNODS)
 
      DO i=1,number_usernods
         nod = usernods(i)
         internal_nod = usr2sys(nod,itabm1,mess,userwi_id )
         user_nds(i) = internal_nod
      ENDDO
 
      ! Sort Nodes
      CALL my_alloc(work,70000)
      CALL my_alloc(idx,2*number_usernods)
      CALL my_alloc(sort,number_usernods)
      DO i=1,number_usernods
         idx(i)=i
         sort(i)=user_nds(i)
      ENDDO
      CALL my_orders(0,work,sort,idx,number_usernods,1)
      DO i=1,number_usernods
         user_windows%USERNODS(i) = sort(idx(i))
      ENDDO
 
      CALL userwis_front(user_windows%USERNODS,number_usernods)
 
      DEALLOCATE(work)
      DEALLOCATE(idx)
      DEALLOCATE(sort)
      DEALLOCATE(user_nds)
 
      END
!||====================================================================
!||    userwis_front           ../starter/source/user_interface/user_windows_tools.F
!||--- called by ------------------------------------------------------
!||    set_user_window_nodes   ../starter/source/user_interface/user_windows_tools.F
!||--- calls      -----------------------------------------------------
!||    ifrontplus              ../starter/source/spmd/node/frontplus.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE userwis_front(USERNODS,NUSERNODS)
!$COMMENT
   ! -----------------------------------------------
   !   ROUTINE DESCRIPTION :
   !   ===================
   !   Set User Windows Node to Proc 1
   ! ------------------------------------------------
   !   DUMMY ARGUMENTS DESCRIPTION:
   !   ===================
   !
   !     NAME          DESCRIPTION                         
   !
   !     USERNODS       Array with User nodes
   !     NUSERNODS      Array size
   !------------------------------------------------------------------
!$ENDCOMMENT
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE my_alloc_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) ::  NUSERNODS
      INTEGER, DIMENSION(1:NUSERNODS),INTENT(IN) ::  USERNODS
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NOD
C======================================================================|
      DO i=1,nusernods
        nod = usernods(i)
        IF (nod/=0)THEN
            CALL ifrontplus(nod,1)
        ENDIF
      ENDDO
      
      END
!||====================================================================
!||    spmd_userwi_rest   ../starter/source/user_interface/user_windows_tools.F
!||--- called by ------------------------------------------------------
!||    ddsplit            ../starter/source/restart/ddsplit/ddsplit.F
!||--- calls      -----------------------------------------------------
!||    nlocal             ../starter/source/spmd/node/ddtools.F
!||    plist_ifront       ../starter/source/spmd/node/ddtools.F
!||--- uses       -----------------------------------------------------
!||    message_mod        ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE spmd_userwi_rest(USER_WINDOWS,NODLOCAL,NUMNOD,NUMNOD_L,
     *                             P,NSPMD)
!$COMMENT
   ! -----------------------------------------------
   !   ROUTINE DESCRIPTION :
   !   ===================
   !   Split & Write UserWindows on disk
   ! ------------------------------------------------
   !   DUMMY ARGUMENTS DESCRIPTION:
   !   ===================
   !
   !     NAME          DESCRIPTION                         
   !
   !     USER_WINDOWS  USER Windows type
   !     NODLOCAL      NODLOCAL ARRAY - Starter to Engine Node numbering
   !     NUMNOD        Total number of nodes
   !     P             Current SPMD Domain to write
   !     NSPMD         Total number of SPMD domains
   !------------------------------------------------------------------
!$ENDCOMMENT
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE my_alloc_mod
      USE message_mod
      USE user_windows_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(user_windows_),INTENT(IN)        :: USER_WINDOWS
      INTEGER,DIMENSION(1:NUMNOD),INTENT(IN) :: NODLOCAL
      INTEGER ,INTENT(IN) :: P,NSPMD,NUMNOD,NUMNOD_L
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER,DIMENSION(:),ALLOCATABLE::FR_USERWI_L
      INTEGER,DIMENSION(:),ALLOCATABLE::IAD_USERW,IAD_USERW2,USERNODS_L
      INTEGER,DIMENSION(:),ALLOCATABLE::PLIST
      INTEGER I,II,J
      INTEGER SFR_USERWI_L,SPLIST,NP,K
      my_real, DIMENSION(:),ALLOCATABLE :: dum_sav
C-----------------------------------------------
C   F u n c t i o n
C-----------------------------------------------     
      INTEGER  NLOCAL
      EXTERNAL nlocal   
C======================================================================|
      CALL write_i_c(user_windows%HAS_USER_WINDOW,1)
      IF(user_windows%HAS_USER_WINDOW /= 0 ) THEN
      
         IF (p == 1)THEN
         
           !  Send Index & Buffer
           ! ---------------------
           CALL my_alloc(iad_userw,nspmd+1)
           CALL my_alloc(plist,nspmd)
           iad_userw(1:nspmd+1)=0
 
           DO ii=1,user_windows%N_USERNODS
               i = user_windows%USERNODS(ii)
               CALL plist_ifront(plist,i,splist)
               DO j=1,splist
                  np = plist(j)
                  IF(np /= 1)THEN
                     iad_userw(np+1)=iad_userw(np+1)+1
                  ENDIF
               ENDDO
           ENDDO
           
           iad_userw(1)=1
           DO np=2,nspmd+1
              iad_userw(np)=iad_userw(np) + iad_userw(np-1)
           ENDDO
           sfr_userwi_l = iad_userw(nspmd+1)-1
           CALL my_alloc(fr_userwi_l,sfr_userwi_l)
           CALL my_alloc(iad_userw2,nspmd+1)
           iad_userw2(1:nspmd+1) = iad_userw(1:nspmd+1)
 
           DO ii=1,user_windows%N_USERNODS
               i = user_windows%USERNODS(ii)
               CALL plist_ifront(plist,i,splist)
               DO j=1,splist
                  np = plist(j)
                  k = iad_userw2(np)
                  fr_userwi_l(k) = nodlocal(k)
                  iad_userw2(np) = iad_userw2(np) + 1
               ENDDO
           ENDDO
           
           !  UserNode LIST Transform
           ! -----------------------
           CALL my_alloc(usernods_l,user_windows%N_USERNODS)
           DO i=1,user_windows%N_USERNODS
               usernods_l(i) = nodlocal(user_windows%USERNODS(i))
           ENDDO
 
           !  WRITE IN RESTART FILE
           ! -----------------------
           ! UserWindows Structure
           CALL write_i_c(user_windows%NUVAR,1)
           CALL write_i_c(user_windows%NUVARI,1)
           CALL write_i_c(user_windows%S_IUSER,1)
           CALL write_i_c(user_windows%S_USER,1)
           CALL write_i_c(user_windows%N_USERNODS,1)
           CALL write_i_c(user_windows%IUSER,user_windows%S_IUSER)
           CALL write_db(user_windows%USREINT,1)
           CALL write_db(user_windows%USER,user_windows%S_USER)
           CALL write_i_c(usernods_l,user_windows%N_USERNODS)
           !SPMD Structures
           CALL write_i_c(sfr_userwi_l,1)
           CALL write_i_c(iad_userw,nspmd+1)
           CALL write_i_c(fr_userwi_l,sfr_userwi_l)
 
           IF(ALLOCATED(usernods_l))   DEALLOCATE(usernods_l)
           IF(ALLOCATED(iad_userw))    DEALLOCATE(iad_userw)
           IF(ALLOCATED(fr_userwi_l))  DEALLOCATE(fr_userwi_l)
           
           ! WRITE A_SAV & AR_SAV only on ispmd==0
           ALLOCATE(dum_sav(3*numnod_l))
           dum_sav(1:3*numnod_l)=zero
           CALL write_db(dum_sav,3*numnod_l)
           CALL write_db(dum_sav,3*numnod_l)
           DEALLOCATE(dum_sav)
 
         ELSE                               ! Receive buffer from P=1
           CALL my_alloc(fr_userwi_l,user_windows%N_USERNODS)
           fr_userwi_l(1:user_windows%N_USERNODS)=0
           sfr_userwi_l = 0
           DO ii=1,user_windows%N_USERNODS
            
              i = user_windows%USERNODS(ii)
              IF(nlocal(i,p)==1)THEN
                 sfr_userwi_l = sfr_userwi_l +1
                 fr_userwi_l(sfr_userwi_l) = nodlocal(i)
              ENDIF
 
           ENDDO
 
           !  WRITE IN RESTART FILE
           ! -----------------------
 
           CALL write_i_c(sfr_userwi_l,1)
           CALL write_i_c(fr_userwi_l,sfr_userwi_l)
           IF(ALLOCATED(fr_userwi_l))  DEALLOCATE(fr_userwi_l)
           
         ENDIF
      ENDIF
 
 
      END