fraleonoff.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	fraleonoff (ikad, key0, kaleonoff, nbaleonoff)

Function/Subroutine Documentation

fraleonoff()

subroutine fraleonoff	(	integer, dimension(0:*)	ikad,
		character, dimension(*)	key0,
		integer	kaleonoff,
		integer	nbaleonoff )

Definition at line 33 of file fraleonoff.F.

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:*), KALEONOFF, NBALEONOFF
      CHARACTER :: KEY0(*)*5
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------      
      INTEGER K, IKEY, II, NB_PARTS, KK
      CHARACTER KEY1*5
      INTEGER, DIMENSION(:), ALLOCATABLE :: PART_IDS
      k = 0
      ikey = kaleonoff
      DO ii = 1, nbaleonoff
         READ (iusc1, rec = ikad(ikey) + k, fmt = '(7X, A, 37X, I10)')
     .        key1, nb_parts
         ALLOCATE (part_ids(nb_parts))
         IF (key1(1:2) == 'ON') THEN
            DO kk = 1, nb_parts
               CALL wriusc2 (ikad(ikey) + kk + k, 1, key0(ikey))
               READ (iusc2, * , err = 9990, END = 9990) PART_IDS(KK)
               WRITE (iin, '(I10, I10)') part_ids(kk), 1
            ENDDO
         ENDIF
         IF (key1(1:3) == 'OFF') THEN
            DO kk = 1, nb_parts
               CALL wriusc2 (ikad(ikey) + kk + k, 1, key0(ikey))
               READ (iusc2, * , err = 9990, END = 9990) PART_IDS(KK)
               WRITE (iin, '(I10, I10)') part_ids(kk), 0
            ENDDO
         ENDIF
         DEALLOCATE (part_ids)
         k = k + 1 + nb_parts
      ENDDO
 9990 CONTINUE