File: pick-dir/rd_unihet.f90

    1       SUBROUTINE RD_UNIHET(Jchan,Uniheterogeneous,Lend,Lverb,J)
    2       USE KINETIC
    3       IMPLICIT NONE
    4 !
    5 ! Dummy arguments
    6 !
    7       INTEGER :: J , Jchan
    8       LOGICAL :: Lend , Lverb
    9       TYPE (UMOLECULARHETEROGENEOUS_RECORD) :: Uniheterogeneous
   10       INTENT (IN) Jchan , Lverb
   11       INTENT (OUT) Lend
   12       INTENT (INOUT) J
   13 !
   14 ! Local variables
   15 !
   16       INTEGER :: i , iwantp , iwantr , jwant_het
   17       LOGICAL :: lset
   18       CHARACTER(20) :: rp_blank
   19 !
   20 !-----------------------------------------------------------------------
   21 !
   22 !     written by:   David Lary
   23 !
   24 !     started:      7/1/1993
   25 !
   26 !     last updated: 22/1/2004
   27 !
   28 !----------------------------------------------------------------------
   29 !
   30 !     Reads in one line of an AutoChem UniHeterogeneous kinetic data file.
   31 !
   32 !     If Lend is true on return then we have reached the end of the
   33 !     file.
   34 !
   35 !----------------------------------------------------------------------
   36 !
   37       Lend = .FALSE.
   38       CALL BLANK(rp_blank)
   39 !
   40 !----------------------------------------------------------------------
   41 !
   42 !     Initialize.
   43       iwantr = 2
   44       iwantp = 14
   45       DO i = 1 , iwantr
   46          CALL BLANK(UNIHETEROGENEOUS%RE(i))
   47       ENDDO
   48       DO i = 1 , iwantp
   49          CALL BLANK(UNIHETEROGENEOUS%P(i))
   50       ENDDO
   51 !
   52 !----------------------------------------------------------------------
   53 !
   54       READ (Jchan,FMT="(i4,1x,a)',END=100,ERR=100) jwant_het ,          &
   55           & uniheterogeneous%comment
   56       J = J + 1
   57       IF ( Lverb ) WRITE (6,FMT="(2i4,1x,a)') jwant_het , J ,           &
   58                         & TRIM(uniheterogeneous%comment)
   59 !
   60       READ (Jchan,FMT="(2x,3x,2(a20,1x))',END=100,ERR=100)              &
   61           & (UNIHETEROGENEOUS%RE(i),i=1,iwantr)
   62       lset = .TRUE.
   63       DO i = 1 , iwantr
   64          IF ( lset ) THEN
   65             IF ( UNIHETEROGENEOUS%RE(i)==rp_blank ) THEN
   66                iwantr = i - 1
   67                lset = .FALSE.
   68             ENDIF
   69          ENDIF
   70       ENDDO
   71       uniheterogeneous%iwantr = iwantr
   72       IF ( Lverb ) WRITE (6,*) "iwantr:' , iwantr
   73 !
   74       IF ( Lverb ) WRITE (6,FMT="(a2,3x,2(a20,1x))') "R:' ,             &
   75                         & (UNIHETEROGENEOUS%RE(i),i=1,iwantr)
   76 !
   77       READ (Jchan,FMT="(2x,3x,14(a20,1x))',END=100,ERR=100)             &
   78           & (UNIHETEROGENEOUS%P(i),i=1,iwantp)
   79       lset = .TRUE.
   80       DO i = 1 , iwantp
   81          IF ( lset ) THEN
   82             IF ( UNIHETEROGENEOUS%P(i)==rp_blank ) THEN
   83                iwantp = i - 1
   84                lset = .FALSE.
   85             ENDIF
   86          ENDIF
   87       ENDDO
   88       uniheterogeneous%iwantp = iwantp
   89       IF ( Lverb ) WRITE (6,*) "iwantp:' , iwantp
   90 !
   91       IF ( Lverb ) WRITE (6,FMT="(1p,a2,3x,14(a20,1x))') "P:' ,         &
   92                         & (UNIHETEROGENEOUS%P(i),i=1,iwantp)
   93 !
   94       READ (Jchan,FMT="(2x,14(e13.4,8x))',END=100,ERR=100)              &
   95           & (uniheterogeneous%z(i),i=1,iwantp)
   96       IF ( Lverb ) WRITE (6,FMT="(1p,a2,14(e13.4,8x))') "#:' ,          &
   97                         & (uniheterogeneous%z(i),i=1,iwantp)
   98 !
   99       READ (Jchan,FMT="(3x,i3,17x,e13.4,11x,a)')                        &
  100           & uniheterogeneous%isptype , uniheterogeneous%gamma ,         &
  101           & uniheterogeneous%fun
  102       READ (Jchan,FMT="(2x,e13.4,/)') uniheterogeneous%rm
  103 !
  104 !----------------------------------------------------------------------
  105 !
  106       RETURN
  107 !
  108 !----------------------------------------------------------------------
  109 !
  110  100  Lend = .TRUE.
  111 !
  112 !----------------------------------------------------------------------
  113 !
  114       END SUBROUTINE RD_UNIHET