create_h3d_arg_keyword.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/.
!||====================================================================
!||    create_h3d_arg_keyword   ../engine/source/output/h3d/h3d_build_fortran/create_h3d_arg_keyword.F
!||--- called by ------------------------------------------------------
!||    lech3d                   ../engine/source/output/h3d/h3d_build_fortran/lech3d.F
!||    prelech3d                ../engine/source/output/h3d/h3d_build_fortran/prelech3d.F90
!||--- calls      -----------------------------------------------------
!||    ancmsg                   ../engine/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    h3d_mod                  ../engine/share/modules/h3d_mod.F
!||    message_mod              ../engine/share/message_module/message_mod.F
!||    names_and_titles_mod     ../common_source/modules/names_and_titles_mod.F
!||====================================================================
      SUBROUTINE create_h3d_arg_keyword(KEY2, KEY3 , KEY4  , KEY5 , KEY6 ,
     .                                  KEY7, KEY8 , IS_ALL,IS_LOWER, IS_UPPER ,
     .                                   ARG , S_ARG, IS_ARG, VALUE, 
     .                                   IS_ARG_ALL,IS_ARG_LOWER,IS_ARG_UPPER, IS_DEF,
     .                                   IS_ARG_DEF,IS_MEMB,IS_ARG_MEMB)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE h3d_mod
      USE names_and_titles_mod, ONLY: ncharkey
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 IS_ALL, IS_UPPER, IS_LOWER, S_ARG, VALUE, IS_ARG, IS_ARG_ALL, IS_ARG_LOWER, IS_ARG_UPPER,
     .        IS_DEF, IS_ARG_DEF, IS_MEMB, IS_ARG_MEMB
      CHARACTER(LEN=NCHARKEY) ::  KEY2, KEY3, KEY4,KEY5,KEY6,KEY7,KEY8
      CHARACTER(LEN=S_ARG) ::  ARG
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER IS_ARG_KEY(5)
C-----------------------------------------------
         IS_ARG_KEY(1:5) = 0
         value = 0
         is_arg = 0
         is_arg_all = 0
         is_arg_lower = 0
         is_arg_upper = 0
         is_arg_def = 0
         is_arg_memb = 0
 
         IF ( key4(1:s_arg) == arg(1:s_arg)) is_arg_key(1) = 1
         IF ( key5(1:s_arg) == arg(1:s_arg)) is_arg_key(2) = 1
         IF ( key6(1:s_arg) == arg(1:s_arg)) is_arg_key(3) = 1
         IF ( key7(1:s_arg) == arg(1:s_arg)) is_arg_key(4) = 1
         IF ( key8(1:s_arg) == arg(1:s_arg)) is_arg_key(5) = 1
 
         IF ( is_arg_key(1) + is_arg_key(2) + is_arg_key(3) + is_arg_key(4)+ is_arg_key(5) > 1)THEN
           CALL ancmsg(msgid=276,c1=arg(1:s_arg+1),c2='/H3D/'//key2//'/'//key3//'/'//key4//'/'//key5//'/'//key6,anmode=aninfo)
         ELSEIF ( is_arg_key(1) + is_arg_key(2) + is_arg_key(3) + is_arg_key(4) + is_arg_key(5) == 1)THEN
           is_arg = 1
           IF ( is_all == 1 .AND.
     .          ((key4(s_arg+1:s_arg+4) == '=ALL' .AND. is_arg_key(1) == 1) .OR. 
     .          (key5(s_arg+1:s_arg+4) == '=ALL' .AND. is_arg_key(2) == 1) .OR. 
     .          (key6(s_arg+1:s_arg+4) == '=ALL' .AND. is_arg_key(3) == 1)  .OR. 
     .          (key7(s_arg+1:s_arg+4) == '=ALL' .AND. is_arg_key(4) == 1)  .OR. 
     .          (key8(s_arg+1:s_arg+4) == '=ALL' .AND. is_arg_key(5) == 1)) )THEN
             is_arg_all = 1
           ELSEIF ( is_lower == 1 .AND.
     .          ((key4(s_arg+1:s_arg+6) == '=LOWER' .AND. is_arg_key(1) == 1) .OR. 
     .          (key5(s_arg+1:s_arg+6) == '=LOWER' .AND. is_arg_key(2) == 1) .OR. 
     .          (key6(s_arg+1:s_arg+6) == '=LOWER' .AND. is_arg_key(3) == 1)  .OR. 
     .          (key7(s_arg+1:s_arg+6) == '=LOWER' .AND. is_arg_key(4) == 1)  .OR. 
     .          (key8(s_arg+1:s_arg+4) == '=ALL' .AND. is_arg_key(5) == 1)) )THEN
             is_arg_lower = 1
           ELSEIF ( is_upper == 1 .AND.
     .          ((key4(s_arg+1:s_arg+6) == '=UPPER' .AND. is_arg_key(1) == 1) .OR. 
     .          (key5(s_arg+1:s_arg+6) == '=UPPER' .AND. is_arg_key(2) == 1) .OR. 
     .          (key6(s_arg+1:s_arg+6) == '=UPPER' .AND. is_arg_key(3) == 1)  .OR. 
     .          (key7(s_arg+1:s_arg+6) == '=UPPER' .AND. is_arg_key(4) == 1)  .OR. 
     .          (key8(s_arg+1:s_arg+4) == '=ALL' .AND. is_arg_key(5) == 1)) )THEN
             is_arg_upper = 1
           ELSEIF ( is_def == 1 .AND.
     .          ((key4(s_arg+1:s_arg+4) == '=DEF' .AND. is_arg_key(1) == 1) .OR. 
     .          (key5(s_arg+1:s_arg+4) == '=DEF' .AND. is_arg_key(2) == 1) .OR. 
     .          (key6(s_arg+1:s_arg+4) == '=DEF' .AND. is_arg_key(3) == 1)  .OR. 
     .          (key7(s_arg+1:s_arg+4) == '=DEF' .AND. is_arg_key(4) == 1)  .OR. 
     .          (key8(s_arg+1:s_arg+4) == '=ALL' .AND. is_arg_key(5) == 1)) )THEN
             is_arg_def = 1
           ELSEIF ( is_memb == 1 .AND.
     .          ((key4(s_arg+1:s_arg+5) == '=MEMB' .AND. is_arg_key(1) == 1) .OR. 
     .           (key5(s_arg+1:s_arg+5) == '=MEMB' .AND. is_arg_key(2) == 1) .OR. 
     .           (key6(s_arg+1:s_arg+5) == '=MEMB' .AND. is_arg_key(3) == 1)  .OR. 
     .           (key7(s_arg+1:s_arg+5) == '=MEMB' .AND. is_arg_key(4) == 1)  .OR. 
     .           (key8(s_arg+1:s_arg+5) == '=MEMB' .AND. is_arg_key(5) == 1)) )THEN
             is_arg_memb = 1
           ELSE
             IF (is_arg_key(1) == 1) READ (key4(s_arg+2:s_arg+11),'(I10)',err=100) VALUE
             IF (is_arg_key(2) == 1) READ (key5(s_arg+2:s_arg+11),'(I10)',err=100) VALUE
             IF (is_arg_key(3) == 1) READ (key6(s_arg+2:s_arg+11),'(I10)',err=100) VALUE
             IF (is_arg_key(4) == 1) READ (key7(s_arg+2:s_arg+11),'(I10)',err=100) VALUE
             IF (is_arg_key(5) == 1) READ (key8(s_arg+2:s_arg+11),'(I10)',err=100) VALUE
           ENDIF
         ENDIF
 
      RETURN
100   CALL ancmsg(msgid=277,c1=arg(1:s_arg)//key2//'/'//key3//'/'//key4//'/'//key5//'/'//key6,anmode=aninfo)
      END