redkey1_h3d.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	redkey1_h3d (key, key0, nkey, carte, ikey, ir)

Function/Subroutine Documentation

redkey1_h3d()

subroutine redkey1_h3d	(	character(len=ncharkey), dimension(*)	key,
		character, dimension(nkey)	key0,
		integer	nkey,
		character(len=ncharline100)	carte,
		integer	ikey,
		integer	ir )

Definition at line 30 of file redkey1_h3d.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE names_and_titles_mod, ONLY: ncharline100,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 NKEY, IKEY, IR, IOK
      CHARACTER(LEN=NCHARLINE100) :: CARTE
      CHARACTER(LEN=NCHARKEY) :: KEY(*)
      CHARACTER KEY0(NKEY)*5
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER IKEYO, J, JK, I
      CHARACTER(LEN=NCHARKEY) :: KEYO(9)
      LOGICAL DETECTED
C-----------------------------------------------
      ir=0
C
      ikeyo=ikey
      DO j=1,9
        keyo(j)=key(j)
        key(j)=' '
      ENDDO
      jk=0
C
      DO i=1,ncharline100
        IF(carte(i:i)=='/')THEN
         jk=jk+1
         j=0
        ELSEIF(carte(i:i)/=' ')THEN
         j=j+1
         IF(j<=ncharkey)key(jk)(j:j)=carte(i:i)
        ENDIF
      ENDDO
C
      detected = .false.
      DO i=1,nkey
        ikey=i
        IF(key(1)(1:5)==key0(ikey)(1:5)) THEN
          detected = .true.
          EXIT
        ENDIF
      ENDDO
 
      IF(.NOT. detected)THEN
       ir=1
       ikey=ikeyo
       DO j=1,9
         key(j)=keyo(j)
       ENDDO
 
      ELSE
        iok = 0
        j=0
 
      ENDIF
 
      RETURN