r2r_prelec_name.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/.
!||====================================================================
!||    r2r_prelec_name        ../starter/source/coupling/rad2rad/r2r_prelec_name.F
!||--- called by ------------------------------------------------------
!||    r2r_fork               ../starter/source/coupling/rad2rad/r2r_fork.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    hm_get_intv            ../starter/source/devtools/hm_reader/hm_get_intv.F
!||    hm_option_read_key     ../starter/source/devtools/hm_reader/hm_option_read_key.F
!||    hm_option_start        ../starter/source/devtools/hm_reader/hm_option_start.f
!||--- uses       -----------------------------------------------------
!||    hm_option_read_mod     ../starter/share/modules1/hm_option_read_mod.F
!||    message_mod            ../starter/share/message_module/message_mod.F
!||    r2r_mod                ../starter/share/modules1/r2r_mod.F
!||    restmod                ../starter/share/modules1/restart_mod.F
!||    submodel_mod           ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE r2r_prelec_name(KDOM,LSUBMODEL)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE message_mod
        USE restmod
        USE r2r_mod
        USE submodel_mod
        USE hm_option_read_mod
        USE names_and_titles_mod , ONLY : nchartitle, ncharkey
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-----------------------------------------------
#include      "r2r_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER KDOM
        TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I,NUSER,N,RLEN,STAT,DEB,K,FLAG_FMT,ID,NEL
        CHARACTER(LEN=NCHARKEY)::KEY
        CHARACTER(LEN=NCHARTITLE)::LOCNAME,TITR
        LOGICAL IS_AVAILABLE
C=======================================================================
C
        is_available = .false.
        CALL hm_option_start('/SUBDOMAIN')
        nb_part_sub = 0
C
        IF (ipid==0) THEN
C--------------------------------------------------------------------C
C------Prereading of domain names --> Child process -----------------C
C--------------------------------------------------------------------C
 
          flag_fmt = 0
 
          DO n=1,nsubdom
C
            CALL hm_option_read_key(lsubmodel,
     .                              option_id = id,
     .                              option_titr = titr,
     .                              keyword2 = key)
C---
            IF(n == kdom)THEN
              dom_name = ''//trim(titr)
            ENDIF
C-----    Computation of total number of parts
            CALL hm_get_intv('idsmax',nel,is_available,lsubmodel)
            nb_part_sub = nb_part_sub + nel
          END DO
 
        ELSE
C--------------------------------------------------------------------C
C------Prereading of domain names --> father process ----------------C
C--------------------------------------------------------------------C
 
          n = 0
          deb = 1
 
C      DO WHILE(N < NSUBDOM)
          DO n=1,nsubdom
C---
C
            CALL hm_option_read_key(lsubmodel,
     .                              option_id = id,
     .                              option_titr = titr,
     .                              keyword2 = key)
 
            locname = ''//trim(titr)
            rlen = len_trim(locname)
            dom_name(deb:deb+rlen-1)=locname(1:rlen)
            isubdom(7,n)=rlen
            isubdom(8,n)=deb
            deb=deb+rlen
C-----    Computation of total number of parts
            CALL hm_get_intv('idsmax',nel,is_available,lsubmodel)
            nb_part_sub = nb_part_sub + nel
C
          END DO
 
C------Check of domain names ----------------C
 
          DO n=1,nsubdom
            DO k=n+1,nsubdom
              IF (isubdom(7,n)==isubdom(7,k)) THEN
                rlen = isubdom(7,n)
                key(1:rlen)=dom_name(isubdom(8,n):isubdom(8,n)+rlen-1)
                titr(1:rlen)=dom_name(isubdom(8,k):isubdom(8,k)+rlen-1)
                IF (key(1:rlen) == titr(1:rlen)) THEN
                  CALL ancmsg(msgid=826,
     .                      msgtype=msgerror,
     .                      anmode=aninfo,i1=isubdom(1,n),
     .                      c1=key(1:rlen))
                  ierr=ierr+1
                ENDIF
              ENDIF
            ENDDO
          ENDDO
 
        ENDIF
 
        RETURN
 
      END SUBROUTINE r2r_prelec_name