 PROGRAM driver_rrtm
   USE module_ra_sw

   IMPLICIT NONE
!
! declarations
!
   INTEGER           :: thisstep
   CHARACTER*256     :: fname

   ! state data for RRTM longwave (outgoing) radiation 
   ! inout 3D
   REAL, ALLOCATABLE :: RTHRATEN(:,:,:)       ! contribution to theta tendency (OUTPUT)
   ! inout 2D
   REAL, ALLOCATABLE :: gsw(:,:)  ! longwave flux
   REAL, ALLOCATABLE :: olr(:,:)  ! longwave flux
   ! in  3D
   REAL, ALLOCATABLE :: p3d(:,:,:)
   REAL, ALLOCATABLE :: pi3d(:,:,:)
   REAL, ALLOCATABLE :: rho_phy(:,:,:)
   REAL, ALLOCATABLE :: dz8w(:,:,:)
   REAL, ALLOCATABLE :: t3d(:,:,:)
   REAL, ALLOCATABLE :: qv3d(:,:,:)        ! water vapor
   REAL, ALLOCATABLE :: qc3d(:,:,:)        ! cloud water
   REAL, ALLOCATABLE :: qr3d(:,:,:)        ! rain water
   REAL, ALLOCATABLE :: qi3d(:,:,:)        ! ice water
   REAL, ALLOCATABLE :: qs3d(:,:,:)        ! snow water
   REAL, ALLOCATABLE :: qg3d(:,:,:)        ! graupel water
   ! in  2D
   REAL, ALLOCATABLE :: xlat(:,:)
   REAL, ALLOCATABLE :: xlong(:,:)           ! skin temp
   REAL, ALLOCATABLE :: albedo(:,:)           ! skin temp
   REAL, ALLOCATABLE :: sina(:,:)           ! skin temp
   REAL, ALLOCATABLE :: cosa(:,:)           ! skin temp
   REAL, ALLOCATABLE :: ht(:,:)           ! skin temp
   REAL ::  GMT,R,CP,G,dt
   INTEGER ::  JULDAY  
   REAL ::  RADFRQ,DEGRAD,XTIME,DECLIN,SOLCON
   REAL ::       dx,dy

!

   LOGICAL :: F_QV, F_QC, F_QR, F_QI, F_QS, F_QG
   LOGICAL :: warm_rain
   INTEGER :: icloud, topo_shading
   
   ! some other variables
   INTEGER :: inflag
   INTEGER :: s,e
   INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte

   ! timer declaration
   INTEGER, EXTERNAL :: rsl_internal_microclock

!
! begin executable statements
!
   ! PRINT*,'RRTM RADIATION DRIVER'
   ! PRINT*,'ENTER INPUT STEP'
   ! READ(*,*) thisstep
   thisstep = 1
 
   ! create file name using internal write then open for reading
   write(fname,'("swrad_in_",i3.3)')thisstep
   open(45,file=fname,form='UNFORMATTED',status='OLD')

   ! read in dimensions of arrays from file and then allocate
   ! for purposes of this driver, we alone use the last set
   !    its, ite  start and end index in west-east dim
   !    jts, jte  start and end index in south-north dim
   !    kts, kte  start and end index in bot-top dim
   ! note that the start dimensions in i and j are probably not '1'

   read(45) ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
   write(0,*)'ids,ide,jds,jde,kds,kde ',ids,ide,jds,jde,kds,kde
   write(0,*)'ims,ime,jms,jme,kms,kme ',ims,ime,jms,jme,kms,kme
   write(0,*)'its,ite,jts,jte,kts,kte ',its,ite,jts,jte,kts,kte

   ! allocate state arrays

   !INOUT 3D
   ALLOCATE( rthraten(ims:ime,kms:kme,jms:jme) )
   !INOUT 2D
   ALLOCATE( GSW(ims:ime,jms:jme) )
   ! IN 3D
   ALLOCATE( p3d(ims:ime,kms:kme,jms:jme) )
   ALLOCATE( pi3d(ims:ime,kms:kme,jms:jme) )
   ALLOCATE( rho_phy(ims:ime,kms:kme,jms:jme) )
   ALLOCATE( dz8w(ims:ime,kms:kme,jms:jme) )
   ALLOCATE( t3d(ims:ime,kms:kme,jms:jme) )
   ALLOCATE( qv3d(ims:ime,kms:kme,jms:jme) )
   ALLOCATE( qc3d(ims:ime,kms:kme,jms:jme) )
   ALLOCATE( qr3d(ims:ime,kms:kme,jms:jme) )
   ALLOCATE( qi3d(ims:ime,kms:kme,jms:jme) )
   ALLOCATE( qs3d(ims:ime,kms:kme,jms:jme) )
   ALLOCATE( qg3d(ims:ime,kms:kme,jms:jme) )
   !IN 2D
   ALLOCATE( XLAT(ims:ime,jms:jme) )
   ALLOCATE( XLONG(ims:ime,jms:jme) )
   ALLOCATE( ALBEDO(ims:ime,jms:jme) )
   ALLOCATE( sina(ims:ime,jms:jme) )
   ALLOCATE( cosa(ims:ime,jms:jme) )
   ALLOCATE( ht(ims:ime,jms:jme) )

   ! read in the rest of the snapshot

   read(45) RADFRQ,DEGRAD,XTIME,DECLIN,SOLCON
   read(45) icloud
   read(45) topo_shading
   read(45)inflag;warm_rain=(inflag.EQ.1)
   read(45)inflag;F_QV=(inflag.EQ.1)
   read(45)inflag;F_QC=(inflag.EQ.1)
   read(45)inflag;F_QR=(inflag.EQ.1)
   read(45)inflag;F_QI=(inflag.EQ.1)
   read(45)inflag;F_QS=(inflag.EQ.1)
   read(45)inflag;F_QG=(inflag.EQ.1)
   !INOUT 3D
   read(45) rthraten(ims:ime,kms:kme,jms:jme)
   !INOUT 2D
   read(45) GSW(ims:ime,jms:jme)
   ! IN 3D
   read(45) p3d(ims:ime,kms:kme,jms:jme)
   read(45) pi3d(ims:ime,kms:kme,jms:jme)
   read(45) rho_phy(ims:ime,kms:kme,jms:jme)
   read(45) dz8w(ims:ime,kms:kme,jms:jme)
   read(45) t3d(ims:ime,kms:kme,jms:jme)
   read(45) qv3d(ims:ime,kms:kme,jms:jme)
   read(45) qc3d(ims:ime,kms:kme,jms:jme)
   read(45) qr3d(ims:ime,kms:kme,jms:jme)
   read(45) qi3d(ims:ime,kms:kme,jms:jme)
   read(45) qs3d(ims:ime,kms:kme,jms:jme)
   read(45) qg3d(ims:ime,kms:kme,jms:jme)
   !IN 2D
   read(45) XLAT(ims:ime,jms:jme)
   read(45) XLONG(ims:ime,jms:jme)
   read(45) ALBEDO(ims:ime,jms:jme)
   read(45) sina(ims:ime,jms:jme)
   read(45) cosa(ims:ime,jms:jme)
   read(45) ht(ims:ime,jms:jme)
   !IN 0D
   read(45) GMT,R,CP,G,dt
   read(45) JULDAY  
   read(45) dx,dy
   close(45)

#ifndef CHOCOLATE

   s = rsl_internal_microclock()

             CALL SWRAD(                                               &
                     DT=dt,RTHRATEN=rthraten,GSW=gsw                   &
                    ,XLAT=xlat,XLONG=xlong,ALBEDO=albedo               &
                    ,RHO_PHY=rho_phy,T3D=t3d                           &
                    ,P3D=p3d,PI3D=pi3d,DZ8W=dz8w,GMT=gmt               &
                    ,R=r,CP=cp,G=g,JULDAY=julday                       &
                    ,XTIME=xtime,DECLIN=declin,SOLCON=solcon           &
                    ,RADFRQ=radfrq,ICLOUD=icloud,DEGRAD=degrad         &
                    ,warm_rain=warm_rain                               &
                    ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &     
                    ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
                    ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
                    ,QV3D=qv3d                                         &
                    ,QC3D=qc3d                                         &
                    ,QR3D=qr3d                                         &
                    ,QI3D=qi3d                                         &
                    ,QS3D=qs3d                                         &
                    ,QG3D=qg3d                                         &
                    ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                     &
                    ,F_QI=f_qi,F_QS=f_qs,F_QG=f_qg                     &
                    ,ht=ht,dx=dx,dy=dy,sina=sina,cosa=cosa             )

   e = rsl_internal_microclock()
   write(*,*)'Time in microseconds for vanilla RRTMLWRAD ',e-s

   write(fname,'("snap_out_",i3.3)')thisstep

#else

    ! GPU init code goes here
   s = rsl_internal_microclock()
    ! GPU code goes here
   e = rsl_internal_microclock()

   write(*,*)'Time in microseconds for chocolate RRTMLWRAD ',e-s
   write(fname,'("snap_gpu_",i3.3)')thisstep

#endif

   open(46,file=fname,form='UNFORMATTED')
   write(46) ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
   write(46) rthraten(ims:ime,kms:kme,jms:jme)
   write(46) gsw(ims:ime,jms:jme)
   close(46)

   stop
   end

