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