Add files via upload

code/rd_js.f

@@ -0,0 +1,64 @@
+C $Id: rd_js.f,v 1.1 2009/06/09 21:51:53 daven Exp $
+      subroutine rd_js(nj1,namfil)
+C-----------------------------------------------------------------------
+c  Reread the ratj.d file to map photolysis rate to reaction
+c  Read in quantum yield 'jfacta' and fastj label 'jlabel'
+C-----------------------------------------------------------------------
+c
+c     jfacta    Quantum yield (or multiplication factor) for photolysis
+c     jlabel    Reference label identifying appropriate J-value to use
+c     ipr       Photolysis reaction counter - should total 'jppj'
+c
+C-----------------------------------------------------------------------
+      IMPLICIT NONE
+
+#     include "cmn_fj.h"
+#     include "jv_cmn.h"
+c
+      integer nj1, ipr, i
+      character*6  namfil
+      character*120 cline
+c
+c Reread the ratj.d file to map photolysis rate to reaction
+c                     Read in quantum yield jfacta and fastj label jlabel
+      ipr=0
+      open(nj1,file=namfil,status='old',form='formatted')
+ 10   read(nj1,'(a)',err=20) cline
+      if(cline(2:5).eq.'9999') then
+         go to 20
+      elseif(cline(1:1).eq.'#') then
+         go to 10
+      elseif(cline(5:5).eq.'$') then
+         go to 10
+      else
+         ipr=ipr+1
+         read(cline(79:83),'(f5.1)') jfacta(ipr)
+         read(cline(86:92),'(a7)')   jlabel(ipr)
+         jfacta(ipr)=jfacta(ipr)/100.d0
+C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+C  Additional code to read reaction names and branch numbers
+C  (ppm, 6/98, bmy, 9/99)
+         read (cline(7:10),"(a4)") rnames(ipr)
+         rnames(ipr) = trim(rnames(ipr))
+         branch(ipr) = 1
+         do i=1,ipr-1
+            if (rnames(ipr) == rnames(i)) branch(ipr) = branch(i) + 1
+         enddo
+C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         go to 10
+      endif
+ 20   close(nj1)
+      if(ipr.ne.jppj) then
+         write(6,1000) ipr,jppj
+         stop
+      endif
+c
+c Print details to standard output
+      write(6,1100) ipr
+      write(6,1200) (i, jlabel(i), jfacta(i),i=1,ipr)
+c
+      return
+ 1000 format(' Error: ',i3,' photolysis labels but ',i3,' reactions')
+ 1100 format(' Fast-J Photolysis Scheme: considering ',i2,' reactions')
+ 1200 format(3x,10(3(i2,': ',a7,' (Q.Y. ',f5.3,') '),/,3x))
+      end