fralnk.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/.
!||====================================================================
!||    fralnk                 ../engine/source/input/fralnk.F
!||--- called by ------------------------------------------------------
!||    freform                ../engine/source/input/freform.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../engine/source/output/message/message.F
!||    arret                  ../engine/source/system/arret.F
!||    ixyz                   ../engine/source/input/ixyz.F
!||    read10                 ../engine/source/input/read10.F
!||    wriusc2                ../engine/source/input/wriusc2.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../engine/share/message_module/message_mod.F
!||    names_and_titles_mod   ../common_source/modules/names_and_titles_mod.f
!||====================================================================
      SUBROUTINE fralnk(IKAD,KEY0,KVEL,NALELK)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE names_and_titles_mod, ONLY: ncharline100
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 IKAD(0:*),KVEL,NALELK
      CHARACTER KEY0(*)*5
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "scr07_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER IXYZ, NVAR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N, NBC, K, KK, NS, K4,IKEY, M1, M2,IERR
      CHARACTER KEY2*5, KEY3*5, KEY4*5
      CHARACTER(LEN=NCHARLINE100) :: CARTE
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      k=0
      kk = 0
      ierr=0
      ikey=kvel
      
       DO n=1,nalelk
         READ(iusc1,
     .        rec=ikad(ikey)+k,
     .        fmt='(7X,A,1X,A,1X,I5,1X,A,20X,I10)',
     .        err=9990)
     .          key2,key3,k4,key4,nbc
         k=k+1
         IF(key2=='TRA  '.OR.key2=='ROT  ')THEN
           k=k+nbc
           cycle
         ENDIF
         CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
         READ(iusc2,*,err=9990,END=9990)M1,m2
         IF(m1<=0.OR.m2<=0)GOTO 9990      !Negative main node null or negative not allowed
         !IF(KEY4(1:5)=='GRNOD')M1=-M1         !Tag on ale link for specific treatment in lectur.F
         
         !---------------------------------!
         !  ALE LINK DEFINED FROM NODES    !
         !---------------------------------!         
         IF(key4(1:5)/='GRNOD')THEN
           k=k+1
           kk=k
           ns=0
           !counting number of nodes           
           DO i=1,nbc-1
             READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
             k=k+1
             ns=ns+nvar(carte)
             IF(ns==0)THEN
               ierr=1
             ENDIF
           ENDDO             
           !checking input             
           IF(ierr==1)THEN
             WRITE(istdo,*)
     .         ' ** ERROR : NODE ID(S) NOT FOUND IN ALE LINK CARD'
             WRITE(iout ,*)
     .         ' ** ERROR : NODE ID(S) NOT FOUND IN ALE LINK CARD'
             CALL arret(2)          
           END IF 
           !array size for allocation (LINALE(SLINALE))           
           llinal=llinal+ns+6                          
         !---------------------------------!
         !  ALE LINK DEFINED FROM GRNOD    !
         !---------------------------------!
         ELSEIF(key4(1:5)=='GRNOD')THEN
           k=k+1
           kk=k
           ns=0
           !counting number of nodes
           DO i=1,nbc-1
             READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
             k=k+1
             IF(nvar(carte)>1.AND.m1<0)THEN !one single id per line
               ierr=1
             ENDIF
             IF(nvar(carte)==1.AND.ns>0)THEN !grnod already defined on a previous line
               ierr=1
             ENDIF
             IF(nvar(carte)==1.AND.ns==0)THEN !first single definition
               ns=1
             ENDIF             
           ENDDO
           !checking input
           IF(ierr==1)THEN
             WRITE(istdo,*)
     .         ' ** ERROR : SINGLE GRNOD ID NOT FOUND IN ALE LINK CARD'
             WRITE(iout ,*)
     .         ' ** ERROR : SINGLE GRNOD ID NOT FOUND IN ALE LINK CARD'
             CALL arret(2)          
           END IF
           ns=-ns
           !array size for allocation (LINALE(SLINALE))           
           llinal=llinal+1+6           
         ENDIF
         
         WRITE(iin,'(3I10,5X,I3.3,I10)')m1,m2,ns,ixyz(key3),k4
         CALL read10(ikad(ikey)+kk,nbc-1,key0(ikey)) 
        
       ENDDO !next N (ALE LINK)
             
      RETURN
 9990 CONTINUE
      CALL ancmsg(msgid=73,anmode=aninfo,
     .            c1=key0(ikey))
      CALL arret(0)
      END
C format v12
!||====================================================================
!||    fralnk2                ../engine/source/input/fralnk.f
!||--- called by ------------------------------------------------------
!||    freform                ../engine/source/input/freform.f
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../engine/source/output/message/message.F
!||    arret                  ../engine/source/system/arret.F
!||    ixyz                   ../engine/source/input/ixyz.F
!||    read10                 ../engine/source/input/read10.F
!||    wriusc2                ../engine/source/input/wriusc2.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../engine/share/message_module/message_mod.F
!||    names_and_titles_mod   ../common_source/modules/names_and_titles_mod.F
!||====================================================================
      SUBROUTINE fralnk2(IKAD,KEY0,KALELINK,NALELK)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE names_and_titles_mod, ONLY: ncharline100
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 IKAD(0:*),KALELINK,NALELK
      CHARACTER KEY0(*)*5
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "scr07_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER IXYZ, NVAR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N, NBC, K, KK, NS, IKEY, M1, M2, IFORM,IERR
      CHARACTER KEY1*5, KEY2*5, KEY3*5, KEY4*5
      CHARACTER(LEN=NCHARLINE100) :: CARTE
C
      k=0
      ierr=0
      ikey=kalelink
      n=0
      DO WHILE(n<nalelk)
        READ(iusc1,rec=ikad(ikey)+k,
     .       fmt='(7X,A,1X,A,1X,I5,1X,A,1X,A,13X,I10)',
     .       err=9990) key1 , key2 , iform  , key3 , key4   ,   nbc
                 !    'LINK','VEL' ,'Iform' ,'XYZ' ,'GRNOD' ,...NBC
        IF(key1(1:5)/='LINK ')THEN
          k=k+1
          cycle
        ENDIF
        n=n+1
        !---------------------------------!
        !  /ALE/LINK/OFF                  !
        !---------------------------------!
        IF(key2(1:5)=='OFF  ')THEN
          ns=0
          k=k+1
          CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
          kk=k
          DO i=0,nbc-1
            READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
            k=k+1
            ns=ns+nvar(carte)
          ENDDO
          WRITE(iin,'(3I10,5X,I3.3,I10)')-2,-2,ns,0,0
          CALL read10(ikad(ikey)+kk,nbc,key0(ikey))
 
        !---------------------------------!
        !  /ALE/LINK/ON                   !
        !---------------------------------!
        ELSEIF(key2(1:5)=='ON  ')THEN
          ns=0
          k=k+1
          CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
          kk=k
          DO i=0,nbc-1
            READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
            k=k+1
            ns=ns+nvar(carte)
          ENDDO
          WRITE(iin,'(3I10,5X,I3.3,I10)')-1,-1,ns,0,0
          CALL read10(ikad(ikey)+kk,nbc,key0(ikey))        
                
        !---------------------------------!
        ! '/ALE/LINK/VEL/*'               !
        !---------------------------------!
        ELSEIF(key2(1:5)=='VEL  ')THEN
          k=k+1
          CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
          READ(iusc2,*,err=9990,END=9990)M1,m2
          IF(m1<=0.OR.m2<=0)GOTO 9990      !Negative main node null or negative not allowed                 
          k=k+1
          kk=k
          ns=0    
          !---------------------------------!
          !  ALE LINK DEFINED FROM NODES    !
          !---------------------------------!
          IF(key4(1:5)=='NODES'.OR.key4(1:5)=='     ')THEN
            DO i=1,nbc-1
             READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
             k=k+1
             ns=ns+nvar(carte)
            ENDDO
            llinal=llinal+ns+6
            !WRITE(IIN,'(3I10,5X,I3.3,I10)')M1,M2,NS,IXYZ(KEY3),IFORM
            !CALL READ10(IKAD(IKEY)+KK,NBC-1,KEY0(IKEY))
          !---------------------------------!
          !  ALE LINK DEFINED FROM GRNOD    !
          !---------------------------------!
          ELSEIF(key4(1:5)=='GRNOD')THEN
            DO i=1,nbc-1
              READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
              k=k+1
              IF(nvar(carte)>1.AND.m1<0)THEN !one single id per line
                ierr=1
              ENDIF
              IF(nvar(carte)==1.AND.ns>0)THEN !grnod already defined on a previous line
                ierr=1
              ENDIF
              IF(nvar(carte)==1.AND.ns==0)THEN !first single definition
                ns=1
              ENDIF             
            ENDDO
            !checking input
            IF(ierr==1)THEN
              WRITE(istdo,*)
     .          ' ** ERROR : SINGLE GRNOD ID NOT FOUND IN ALE LINK CARD'
              WRITE(iout ,*)
     .          ' ** ERROR : SINGLE GRNOD ID NOT FOUND IN ALE LINK CARD'
              CALL arret(2)          
            END IF  
            ns=-ns
            llinal=llinal+1+6             
          ENDIF     
          !---------------------------------!                    
          WRITE(iin,'(3I10,5X,I3.3,I10)')m1,m2,ns,ixyz(key3),iform
          CALL read10(ikad(ikey)+kk,nbc-1,key0(ikey))                  
 
        ENDIF !(key2=='vel  ')
      ENDDO
C
      RETURN
C
 9990 CONTINUE
      CALL ANCMSG(MSGID=73,ANMODE=ANINFO,
     .            C1=KEY0(IKEY))
      CALL ARRET(0)
      END