! Dummy version of ncar routines when ncar library isn't available. ! Based on ncar_r8.f90. ! ! Wrapper/interface for NCAR graphics routines, to convert 8-byte reals ! used in the main code to 4-byte reals used in ncar. ! ! To use this in a code, include the statement: ! ! use ncar_mod, plchlq => plchlq8, curved => curved8, curve => curve8, & ! set => set8, line => line8, lined => lined8, & ! cpsetr => cpsetr8, cprect => cprect8, cpcldr => cpcldr8, & ! gridal => gridal8 ! ! and make the unix logical link: ! ! ln -sf ncar_mod_stub.f90 ncar_mod.f90 ! ! On computers where the real*4 is not supported (and is treated like ! real*8, such as on the Cray T3E and C90), this will work correctly ! and simply pass the data unchanged to ncar. ! module ncar_mod implicit none contains ! Unresolved text symbol "plchlq_" -- 1st referenced by plots.o. subroutine plchlq8 (xpos8, ypos8, chrs, size8, angd8, cntr8) real*8 xpos8, ypos8, size8, angd8, cntr8 real*4 xpos, ypos, size, angd, cntr character*(*) chrs xpos=xpos8 ypos=ypos8 size=size8 angd=angd8 cntr=cntr8 ! call plchlq (xpos, ypos, chrs, size, angd, cntr) return end subroutine plchlq8 ! Unresolved text symbol "curved_" -- 1st referenced by plots.o. subroutine curved8(x8,y8,n) integer n real*8 x8(n), y8(n) real*4 x(n), y(n) x=x8 y=y8 ! call curved(x,y,n) return end subroutine curved8 ! Unresolved text symbol "curve_" -- 1st referenced by plots.o. subroutine curve8(x8,y8,n) integer n real*8 x8(n), y8(n) real*4 x(n), y(n) x=x8 y=y8 ! call curve(x,y,n) return end subroutine curve8 ! Unresolved text symbol "set_" -- 1st referenced by plots.o. subroutine set8( vl8, vr8, vb8, vt8, wl8, wr8, wb8, wt8, lf) real*8 vl8, vr8, vb8, vt8, wl8, wr8, wb8, wt8 real*4 vl , vr , vb , vt , wl , wr , wb , wt integer lf vl=vl8 vr=vr8 vb=vb8 vt=vt8 wl=wl8 wr=wr8 wb=wb8 wt=wt8 ! call set( vl, vr, vb, vt, wl, wr, wb, wt, lf) return end subroutine set8 ! Unresolved text symbol "line_" -- 1st referenced by plots.o. subroutine line8(x18, y18, x28, y28) real*8 x18, y18, x28, y28 real*4 x1 , y1 , x2 , y2 x1=x18 y1=y18 x2=x28 y2=y28 ! call line( x1 , y1, x2, y2) return end subroutine line8 ! Unresolved text symbol "lined_" -- 1st referenced by plots.o. subroutine lined8(x18, y18, x28, y28) real*8 x18, y18, x28, y28 real*4 x1 , y1 , x2 , y2 x1=x18 y1=y18 x2=x28 y2=y28 ! call lined( x1 , y1, x2, y2) return end subroutine lined8 ! Unresolved text symbol "cpsetr_" -- 1st referenced by plots.o. subroutine cpsetr8(pnam,rval8) real*8 rval8 real*4 rval character*(*) pnam rval=rval8 ! call cpsetr(pnam,rval) return end subroutine cpsetr8 ! Unresolved text symbol "cprect_" -- 1st referenced by plots.o. subroutine cprect8 (zdat8, kzdt, mzdt, nzdt, rwrk8, lrwk, iwrk, liwk) integer kzdt, mzdt, nzdt, lrwk, liwk integer iwrk(liwk) real*8 zdat8(kzdt,nzdt), rwrk8(lrwk) real*4 zdat(kzdt,nzdt) ! real*4 rwrk(lrwk) zdat=zdat8 ! rwrk=rwrk8 ! The work array does not need to be copied ! call cprect (zdat, kzdt, mzdt, nzdt, rwrk8, lrwk, iwrk, liwk) return end subroutine cprect8 ! Unresolved text symbol "cpcldr_" -- 1st referenced by plots.o. subroutine cpcldr8(zdat8, rwrk8, iwrk) real*8 zdat8(:,:), rwrk8(:) real*4 zdat(size(zdat8,1),size(zdat8,2)) ! real*4 rwrk(size(rwrk8)) integer iwrk(:) zdat=zdat8 ! rwrk=rwrk8 ! The work array does not need to be copied. ! call cpcldr(zdat, rwrk8, iwrk) return end subroutine cpcldr8 ! Unresolved text symbol "gridal_" -- 1st referenced by graphics.o. subroutine gridal8 (mjrx, mnrx, mjry, mnry, ixlb, iylb, igph, & xint8, yint8) integer mjrx, mnrx, mjry, mnry, ixlb, iylb, igph real*8, intent(in) :: xint8, yint8 real*4 xint, yint xint=xint8 yint=yint8 ! call gridal (mjrx, mnrx, mjry, mnry, ixlb, iylb, igph, & ! xint, yint) return end subroutine gridal8 ! The following NCAR routines all have integer-only arguments: ! ! Unresolved text symbol "cpseti_" -- 1st referenced by plots.o. subroutine cpseti(pnam, ival) character*(*) pnam integer ival return end subroutine cpseti ! Unresolved text symbol "dashdb_" -- 1st referenced by plots.o. subroutine dashdb(ipat) integer ipat return end subroutine dashdb ! Unresolved text symbol "labmod_" -- 1st referenced by graphics.o. subroutine labmod(fmtx,fmty,numx,numy,iszx,iszy,ixdc,iydc,ixor) character(*) :: fmtx, fmty integer :: numx, numy, iszx, iszy, ixdc, iydc, ixor return end subroutine labmod ! Unresolved text symbol "plotit_" -- 1st referenced by graphics.o. subroutine plotit(ix,iy,ip) integer ix,iy,ip end subroutine plotit ! Unresolved text symbol "frame_" -- 1st referenced by graphics.o. subroutine frame return end subroutine frame ! Unresolved text symbol "gopks_" -- 1st referenced by postc.o. subroutine gopks(errfil, bufa) integer errfil, bufa return end subroutine gopks ! Unresolved text symbol "gesc_" -- 1st referenced by postc.o. subroutine gesc(fctid, lidr, idr, mxodr, lodr, odr) integer fctid, lidr, mxodr, lodr character*(*) idr, odr return end subroutine gesc ! Unresolved text symbol "gopwk_" -- 1st referenced by postc.o. subroutine gopwk(wkid, conid, wktype) integer wkid, conid, wktype return end subroutine gopwk ! Unresolved text symbol "gacwk_" -- 1st referenced by postc.o. subroutine gacwk(wkid) integer wkid return end subroutine gacwk ! Unresolved text symbol "reset_" -- 1st referenced by postc.o. subroutine reset return end subroutine reset ! Unresolved text symbol "gdawk_" -- 1st referenced by postc.o. subroutine gdawk(wkid) integer wkid return end subroutine gdawk ! Unresolved text symbol "gclwk_" -- 1st referenced by postc.o. subroutine gclwk(wkid) integer wkid return end subroutine gclwk ! Unresolved text symbol "gclks_" -- 1st referenced by postc.o. subroutine gclks return end subroutine gclks end module ncar_mod