c  $Header: /usr/people/flittner/radtran/tomrad/pv2.2/src/RCS/rdprof.f,v 2.22 2000/08/30 16:38:09 flittner Exp $
       subroutine rdprof(p,z,t,no3,toto3,mz,nz)
c read a user profile instead of the PROF file for the
c pressure,alt,temp,o3 press,vmr
c the file userfn should have the following structure
c o3 profile is (atm-cm)
c 0.306
c P(mb)  ALT(km) Tamb(C) OZ(mPa)
c x       x       x       x    
c
c where ppmv is the volume mixing ratio
c
c last mod. Oct. 14, 1998...def
c purpose: read til the end of the file
c
c last mod. Nov. 2, 1999...def
c purpose: prevent memory leaks, combine do-loops, tidy-up ppmv
c
c last mod. Feb. 7, 2000...def
c purpose: set max. input pressure to be 1 atm.
c
       implicit none
       include 'cfilenames.cmn'
c passed
       integer nz,mz
       real*8 p(mz),z(mz),t(mz),no3(mz),toto3
c local
       integer i,io3_units
       logical ex
       character*20 buf
       real*8 rh,tmp,line1(6)
c
       inquire(file=userfn,exist=ex)
       if(ex)then
         open(25,file=userfn)
c skip the header
c read the total of the profile
         read(25,'(a)')buf
         read(25,*)toto3
         read(25,'(a)')buf
c check for the units of the ozone column
         if(index(buf,'DU/km').gt.0)then
           io3_units=1
         else if(index(buf,'cm-3').gt.0)then
           io3_units=2
         else
           io3_units=0
         endif
         i=1
c to read the old style of file
c10       read(25,*,end=20)p(i),z(i),t(i),rh,po3(i),vmr(i)
10       read(25,*,end=20)p(i),z(i),t(i),no3(i)
           if(i.eq.mz)then
c             write(6,*)'rdprof. ',p(i),z(i),t(i),rh,po3(i),vmr(i)
c the file is too long.  Just how long is it?
             i=i+1
15           read(25,*,end=17)line1
             i=i+1
             goto 15
17           i=i-1
             if(i.gt.mz)then
               write(6,1000)userfn,i,mz,i
1000         format('rdprof. the user input profile ',/,a100,/,
     &' has more lines (',i4,') than the input arrays have ',
     &'elements (',i4,').',/,' You must change the parameter ',
     &'muser in subroutine relayr to be greater',/,' than or ',
     &'equal to ',i4,' and recompile tomrad to use this user ',
     &'input',/,' profile file.')
               stop
             endif
           endif
           i=i+1
           goto 10
20       nz=i-1
         close(25)
c reverse the order
         do i=1,nz/2
c p
            tmp=p(i)
            p(i)=p(nz-i+1)
            p(nz-i+1)=tmp
c z
            tmp=z(i)
            z(i)=z(nz-i+1)
            z(nz-i+1)=tmp
c t
            tmp=t(i)
            t(i)=t(nz-i+1)
            t(nz-i+1)=tmp
c for the old style
cc po3
c            tmp=po3(i)
c            po3(i)=po3(nz-i+1)
c            po3(nz-i+1)=tmp
c no3
            tmp=no3(i)
            no3(i)=no3(nz-i+1)
            no3(nz-i+1)=tmp
cc vmr
c            tmp=vmr(i)
c            vmr(i)=vmr(nz-i+1)
c            vmr(nz-i+1)=tmp
         enddo
c
c convert T from C to K
         do i=1,nz
            t(i)=t(i)+273.15d0
c calc number density of o3 in terms of atm-cm/km
            if(io3_units.eq.0)then
c from mPa to atm-cm/km
              no3(i)=(no3(i)/t(i)/3.709494d-00)
cc convert pres from mPa to atm
c              po3(i)=po3(i)*1.0d-05/1013.25d0
            else if(io3_units.eq.1)then
c from DU/km to atm-cm/km
              no3(i)=no3(i)*1.0e-03
c from DU/km to atm
c              po3(i)=no3(i)*t(i)*3.709494e-00*1.0e03*1.0d-05/1013.25d0
            else if(io3_units.eq.2)then
c from cc to atm-cm/km
              no3(i)=no3(i)*1.0e06/2.68684e20
c from cc to atm
c              po3(i)=po3(i)*t(i)*1.38e12 / 1.01325
            endif
c convert pres from mb to atm
            p(i)=p(i)/1013.25
         enddo
c check to see that the surface pressure is less than or equal to 1.0
         if(p(1).gt.1.0d0)then
           write(6,*)'rdprof. The input user profile has a surface'
           write(6,*)'        pressure greater than than the maximum'
           write(6,*)'        allowable surface pressure of 1.0 atm.'
           stop
         endif
       else
         write(6,*)'rdprof. WARNING*******'
         WRITE(6,*)'rdprof. the file ',userfn,
     &' does not exist so we '
         write(6,*)'rdprof. will stop now '
         stop
       endif
       return
       end