read5p.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	read5p (irec, nbc, key0, iv2, jj)

Function/Subroutine Documentation

read5p()

subroutine read5p	(	integer	irec,
		integer	nbc,
		character, dimension(*)	key0,
		integer, dimension(*)	iv2,
		integer	jj )

Definition at line 30 of file read5p.F.

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 IV2(*), IREC, NBC, JJ
      CHARACTER KEY0*(*)
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, I, N, J, NC1, NC2, NTOT
      INTEGER, DIMENSION(:), ALLOCATABLE :: IV0,IV1
C-----------------------------------------------
C
C     First pass - count total number of elements
c
      ntot=0
      k=0
      DO i=1,nbc
        CALL wciusc2(irec+k,1,n,key0)
        k=k+1
        ntot = ntot + n
      ENDDO ! I
 
      IF(ntot==0)RETURN ! No elements to read
 
C     Second pass - read all lines of elements as a single big line
      ALLOCATE(iv0(ntot))
      ALLOCATE(iv1(2*ntot))
      iv0(1:ntot) = 0
      iv1(1:2*ntot) = 0
C
      ntot = 0
      k=0
      DO i=1,nbc
        CALL wciusc2(irec+k,1,n,key0)
        READ(iusc2,*)(iv0(j),j=1,n)
        DO j=1,n
           iv1(2*(ntot+j) - 1) = iv0(j)
           iv1(2*(ntot+j))     = iv0(j)
        ENDDO
        ntot = ntot + n
        k=k+1
      ENDDO  
C      
C     Write the elements in groups of 10 - last line completed with last element
      n=2*ntot
      nc1=1
      nc2 = 0
      DO WHILE(nc2 < n)
        jj = 0
        nc2=min(nc1+9-jj,n)
        DO j=nc1,nc2
          jj=jj+1
          iv2(jj)=iv1(j)
        ENDDO
        DO k=jj+1,10,2
          iv2(k)=iv2(jj-1)
          iv2(k+1)=iv2(jj)
        ENDDO
        WRITE(iin,'(10I10)')(iv2(j),j=1,10)
        nc1=nc2+1
      ENDDO
      jj = 0
 
      DEALLOCATE(iv0)
      DEALLOCATE(iv1)
 
      RETURN