create_h3d_arg_keyword.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
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)

Function/Subroutine Documentation

create_h3d_arg_keyword()

subroutine create_h3d_arg_keyword	(	character(len=ncharkey)	key2,
		character(len=ncharkey)	key3,
		character(len=ncharkey)	key4,
		character(len=ncharkey)	key5,
		character(len=ncharkey)	key6,
		character(len=ncharkey)	key7,
		character(len=ncharkey)	key8,
		integer	is_all,
		integer	is_lower,
		integer	is_upper,
		character(len=s_arg)	arg,
		integer	s_arg,
		integer	is_arg,
		integer	value,
		integer	is_arg_all,
		integer	is_arg_lower,
		integer	is_arg_upper,
		integer	is_def,
		integer	is_arg_def,
		integer	is_memb,
		integer	is_arg_memb )

Definition at line 35 of file create_h3d_arg_keyword.F.

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)