PROGRAM driver_rrtm
   USE module_ra_rrtm

   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 :: glw(:,:)  ! longwave flux
   REAL, ALLOCATABLE :: olr(:,:)  ! longwave flux
   ! in  3D
   REAL, ALLOCATABLE :: dz8w(:,:,:)
   REAL, ALLOCATABLE :: T3D(:,:,:)
   REAL, ALLOCATABLE :: t8w(:,:,:)
   REAL, ALLOCATABLE :: p8w(:,:,:)
   REAL, ALLOCATABLE :: P3D(:,:,:)
   REAL, ALLOCATABLE :: pi3D(:,:,:)
   REAL, ALLOCATABLE :: rho3D(:,:,:)
   REAL, ALLOCATABLE :: cldfra3d(:,:,:)    ! cloud fraction
   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 :: emiss(:,:)
   REAL, ALLOCATABLE :: tsk(:,:)           ! skin temp
   REAL              :: r, g       

   LOGICAL :: F_QV, F_QC, F_QR, F_QI, F_QS, F_QG
   LOGICAL :: warm_rain
   INTEGER :: icloud
   
   ! 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,'("rrtmlw_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( glw(ims:ime,jms:jme) )
   ALLOCATE( olr(ims:ime,jms:jme) )
   !IN 3D
   ALLOCATE( dz8w(ims:ime,kms:kme,jms:jme)) 
   ALLOCATE( T3D(ims:ime,kms:kme,jms:jme))
   ALLOCATE( t8w(ims:ime,kms:kme,jms:jme))
   ALLOCATE( p8w(ims:ime,kms:kme,jms:jme))
   ALLOCATE( P3D(ims:ime,kms:kme,jms:jme))
   ALLOCATE( pi3D(ims:ime,kms:kme,jms:jme))
   ALLOCATE( rho3D(ims:ime,kms:kme,jms:jme))
   ALLOCATE( cldfra3d(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( emiss(ims:ime,jms:jme) )
   ALLOCATE( tsk(ims:ime,jms:jme) )

   ! read in the rest of the snapshot

   read(45) icloud
   ! read in as integer and convert to logical because cannot 
   ! assume same representation across machines
   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) glw(ims:ime,jms:jme)
   read(45) olr(ims:ime,jms:jme)
   !IN 3D
   read(45) dz8w(ims:ime,kms:kme,jms:jme)
   read(45) T3D(ims:ime,kms:kme,jms:jme)
   read(45) t8w(ims:ime,kms:kme,jms:jme)
   read(45) p8w(ims:ime,kms:kme,jms:jme)
   read(45) P3D(ims:ime,kms:kme,jms:jme)
   read(45) pi3D(ims:ime,kms:kme,jms:jme)
   read(45) rho3D(ims:ime,kms:kme,jms:jme)
   read(45) cldfra3d(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) emiss(ims:ime,jms:jme)
   read(45) tsk(ims:ime,jms:jme)
   !IN 0D
   read(45) r,g
   close(45)

   ! call rrtm longwave package

#ifndef CHOCOLATE

   CALL RRTMINIT( .TRUE.   &
                 ,ids,ide, jds,jde, kds,kde                 & 
                 ,ims,ime, jms,jme, kms,kme                 &
                 ,its,ite, jts,jte, kts,kte                 )

   s = rsl_internal_microclock()
   CALL RRTMLWRAD(rthraten,glw,olr,emiss                    &
                 ,p8w,p3d,pi3d                              &
                 ,dz8w,tsk,t3d,t8w,rho3d,r,g                &
                 ,icloud, warm_rain                         &
                 ,ids,ide, jds,jde, kds,kde                 & 
                 ,ims,ime, jms,jme, kms,kme                 &
                 ,its,ite, jts,jte, kts,kte                 &
                 ,qv3d,qc3d,qr3d                            &
                 ,qi3d,qs3d,qg3d,cldfra3d                   &
                 ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg             &
                                                            )
   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) olr(ims:ime,jms:jme)
   write(46) glw(ims:ime,jms:jme)
   close(46)

   stop
   end