RMAGEN84/SRC84/GETCRS.F90

      SUBROUTINE GETCRS(CRSTIT)
	
      USE BLK1MOD
!      INCLUDE 'BLK1.COM'

	  CHARACTER*8 ID1
	  CHARACTER*72 DLIN1,CRSTIT

!IPK JUN06
      DATA VOIDCR/-1.E15/
      MCRS=0
      MPTS=00
      DO
        call ginpt(icrin,id1,dlin1)
  	    IF(ID1(1:3) .EQ. 'ICS') THEN
	      READ(DLIN1,'(I8)') MILCT
          MCRS=MAX(MILCT,MCRS)
          MPTCT=0
          DO
            call ginpt(icrin,id1,dlin1)
     	    IF(ID1(1:3) .EQ. 'CRS') THEN
              MPTCT=MPTCT+1
            ELSE
              MPTS=MAX(MPTCT,MPTS)
              EXIT
            ENDIF
          ENDDO  
        ELSEIF(ID1(1:7) .EQ. 'ENDDATA') THEN
          REWIND (ICRIN)
          EXIT
        ENDIF
      ENDDO

      ALLOCATE (IVMIL(MCRS),NRIVL(MCRS),NOREACH(MCRS)&
               ,CRSDAT(MCRS,-4:MPTS,3),XCRS(MCRS),YCRS(MCRS))
      
      XCRS=VOIDCR
	  YCRS=VOIDCR
      NRIVCR1=0
      NRIVCR2=0
!ipk jun11                
      NOREACH=0
      NRIVL=0
      IVMIL=0
      WTRIVCR1=0.
      WTRIVCR2=0.

      call ginpt(icrin,id1,dlin1)

      IF(ID1(1:2) .EQ. 'TC') THEN
        CRSTIT=DLIN1
        call ginpt(icrin,id1,dlin1)
      ELSE
        CALL WMessageBox(0,3,1,'Cross-section Title not found'//char(13)//&
        'Cross-section file input terminated','ERROR')
        return
      ENDIF 
      N=0

  200 N=N+1
      IF(N .GT. MCRS+1) THEN
        CALL WMessageBox(0,3,1,'Allowable number of sections (1000) exceeded'//char(13)//&
        'Cross-section file input terminated','ERROR')
        return
      ENDIF
      IF(ID1(1:3) .EQ. 'RCH') THEN
        READ(DLIN1,'(I8)') NOREACHTMP
		write(90,'(a)') 'rch',id1,dlin1
        Call ginpt(icrin,id1,dlin1)
      ENDIF

	  IF(ID1(1:3) .EQ. 'ICS') THEN
	    READ(DLIN1,'(2I8,8x,2f16.0)') IVMIL(N),NRIVL(IVMIL(N)),XCRS(IVMIL(N)),YCRS(IVMIL(N))

!
!                              IVMIL =  CROSS-SECTION NUMBER
!                              NRIVL =  NUMBER OF POINTS IN SECTION
!                              NOREACH = REACH/TYPE NUMBER
!                              CRSDAT  1 = ELEVATION
!                              CRSDAT  2 = AREA
!                              CRSDAT  3 = WIDTH

        write(90,'(a)') 'ics',id1,dlin1
		NOREACH(IVMIL(N))=NOREACHTMP
        IF(NRIVL(IVMIL(N)) .GT. MPTS) THEN
          CALL WMessageBox(0,3,1,'Allowable number of points in a cross-section (75) exceeded'//char(13)//&
          'Cross-section file input terminated','ERROR')
          return
        ENDIF
!        IF(NOREACH(N) .EQ. 0) THEN
!          IF(N .GT. 1) THEN
!            NOREACH(N)=NOREACH(N-1)
!          ELSE
!            NOREACH(N)=1
!          ENDIF
!        ENDIF
        call ginpt(icrin,id1,dlin1)
 	    DO I=1,NRIVL(IVMIL(N))
		  write(90,'(a)') 'crs',id1,dlin1
          READ(DLIN1,'(3F8.0)') (CRSDAT(IVMIL(N),I,J),J=1,3)
!IPK JUN04
	      if(i .gt. 1) then
              CRSDAT(IVMIL(N),I,2)=CRSDAT(IVMIL(N),I-1,2)+&
      	     (CRSDAT(IVMIL(N),I,1)-CRSDAT(IVMIL(N),I-1,1))*&
               (CRSDAT(IVMIL(N),I,3)+CRSDAT(IVMIL(N),I-1,3))/2.
	      endif
          call ginpt(icrin,id1,dlin1)
	    ENDDO
        NCRSEC=N
! TEST        NCRSEC=MAX(N,IVMIL(N))
        GO TO 200
      ENDIF

!ipk jun06      DO N=1,NCRSEC

      DO N=1,MCRS
        IF(ID1(1:3) .EQ. 'XYL') THEN
          READ(DLIN1,'(I8,2F16.0)') NN,XCRS(NN),YCRS(NN)
!IPK JUN06
          IF(NN .GT. NCRSEC) NCRSEC=NN
          call ginpt(icrin,id1,dlin1)
        ELSE 
          GO TO 400
        ENDIF
      ENDDO

  400 CONTINUE
      DO N=1,MAXP
        IF(ID1(1:3) .EQ. 'CRF') THEN
	      READ(DLIN1,'(2I8,F8.0,I8,F8.0)') NODCRS&
            ,NRIVCR1(NODCRS),WTRIVCR1(NODCRS)&
            ,NRIVCR2(NODCRS),WTRIVCR2(NODCRS)
          call ginpt(icrin,id1,dlin1)
        ELSE
	      GO TO 500
        ENDIF
      ENDDO        
  500 CONTINUE

      CLOSE(ICRIN)
  
!     CHECK THE DATA LOADED

      IERR=0
      DO N=1,NE
	    IF(IMAT(N) .LT. 900) THEN
          IF(NCORN(N) .EQ. 3  .OR. NCORN(N) .EQ. 5) THEN
	       DO J=1,3,2
	        IF(NRIVCR1(NOP(N,J)) .NE. 0) THEN
	          WD1(NOP(N,J))=&
                CRSDAT(NRIVCR1(NOP(N,J)),1,1)*WTRIVCR1(NOP(N,J))+&
                CRSDAT(NRIVCR2(NOP(N,J)),1,1)*WTRIVCR2(NOP(N,J))
!			ELSE
!	       WRITE(75,*) ' NO CROSS-SECTION FILE REFERENCE FOR',NOP(N,J)
!             WRITE(75,*) ' EXECUTION TERMINATED'
!	       WRITE(*,*) ' NO CROSS-SECTION FILE REFERENCE FOR',NOP(N,J)
!             WRITE(*,*) ' EXECUTION TERMINATED'
!	       IERR=IERR+1
            ELSE
			  WD1(NOP(N,J))=WD(NOP(N,J)) 
            ENDIF
!     
	       ENDDO

           IF(NOP(N,2) .GT. 0) WD1(NOP(N,2))=(WD1(NOP(N,1))+WD1(NOP(N,3)))/2.
!
          ELSE
		    DO J=1,NCORN(N)
		      WD1(NOP(N,J))=WD(NOP(N,J))      
			ENDDO
	      ENDIF
        ENDIF
      ENDDO
  
	  RETURN
	  END

      SUBROUTINE WRTCRS(ICROUT,CRSTIT)
	
      USE BLK1MOD
!      INCLUDE 'BLK1.COM'
!      COMMON/ICN1/ ICN(MAXP) 
   

      CHARACTER*8 ID1,ENDDAT
      CHARACTER*72 CRSTIT

!IPK JUN06
      DATA VOIDCRP/-1.E14/            

      DO J=1,MAXP 
        ICN(J)=0 
      END DO 
!     First sort out the potential midsides                             
!     Note that transition elements caues a problem                     
!     Find these first                                                  
      DO 200 N=1,NE 
        if(NCORN(N) .GT. 5) GO TO 200
        IF(NCORN(N) .EQ. 5  .AND.  IMAT(N) .LT. 901) THEN 
!                                                                       
!     We have a transition  mark node number as if it were corner       
!                                                                       
          ICN(NOP(N,3))=1 
          ICN(NOP(N,1))=2 
          ICN(NOP(N,4))=2 
          ICN(NOP(N,5))=2 
        ELSE 
!                                                                       
!     Store ICN = 2 for corner nodes                                    
!                                                                       
          NCN=NCORN(N) 
!IPKOCT93          IF(IMAT(N) .GT. 900) THEN                            
          IF(IMAT(N) .GT. 900  .AND.  IMAT(N) .LT. 904) THEN 
            MST=1 
          ELSE 
            MST=2 
          ENDIF 
                    
          DO 180 M=1,NCN,MST 

           ICN(NOP(N,M))=2 
  180     CONTINUE 
        ENDIF 
  200 END DO
      ID1='TC      '
       WRITE(ICROUT,'(A8,A72)') ID1,CRSTIT

       
      DO N=1,NCRSEC
!ipk jun06 
!!	   IF(NRIVL(N) .GT. 0) THEN
        ID1='RCH     '
        WRITE(ICROUT,'(A8,I8)') ID1,NOREACH(IVMIL(N))
        ID1='ICS     '
!!	    write(icrout,'(A8,2I8,8x,2f16.4)') ID1,IVMIL(N),NRIVL(N),XCRS(N),YCRS(N)
!!jul15	    write(icrout,'(A8,2I8,8x,2f16.4)') ID1,N,NRIVL(N),XCRS(N),YCRS(N)
	    write(icrout,'(A8,2I8,8x,2f16.4)') ID1,IVMIL(N),NRIVL(IVMIL(N)),XCRS(IVMIL(N)),YCRS(IVMIL(N))
        ID1='CRS     '
        DO I=1,NRIVL(IVMIL(N))
          if(crsdat(IVMIL(N),i,2) .gt. 999999.) then 
            WRITE(ICROUT,'(A8,3F8.0)') ID1,(CRSDAT(IVMIL(N),I,J),J=1,3)
          elseif(crsdat(IVMIL(N),i,2) .gt. 99999.) then 
            WRITE(ICROUT,'(A8,3F8.1)') ID1,(CRSDAT(IVMIL(N),I,J),J=1,3)
          else
            WRITE(ICROUT,'(A8,3F8.2)') ID1,(CRSDAT(IVMIL(N),I,J),J=1,3)
          endif
        ENDDO
!ipk jun06 
!!	   ENDIF
      ENDDO


      DO N=1,NCRSEC
!ipk jun06 
	   IF(XCRS(N) .GT. VOIDCRP) THEN
        ID1='XYL     '
        WRITE(ICROUT,'(A8,I8,2F16.4)') ID1,IVMIL(N),XCRS(IVMIL(N)),YCRS(IVMIL(N))
!ipk jun06 
       ENDIF
      ENDDO

      ID1='CRF     '
      DO N=1,NP
        IF(ICN(N) .EQ. 2) THEN
          IF(NRIVCR1(N) .GT. 0) THEN
            WRITE(ICROUT,'(A8,2I8,F8.4,I8,F8.4)') ID1,N&
            ,NRIVCR1(N),WTRIVCR1(N)&
            ,NRIVCR2(N),WTRIVCR2(N)
          ENDIF
        ENDIF
      ENDDO

      ENDDAT='ENDDATA '
      WRITE(ICROUT,'(A8)') ENDDAT
      RETURN
      END