subroutine dtcidate (imr, idr, iyr) c c Testing aid for DTC - allows for phony value of current date to be c returned to caller, for verifying displays, etc c c Calling sequence - same as Fortran IDATE c include 'comdtc.inc/nolist' include 'dtcxidate.inc/nolist' include 'defcentry.inc/list' c if (xim .eq. 0) then ! Assumes linker initializes to zero call idate (xim, xid, xiy) xibgyr = icntry + xiy ! Set long value end if imr = xim idr = xid iyr = xibgyr end subroutine dtcicomd c c Process "I" command: if no arguments, reset dummy IDATE to current date, c else call dtcdatcvt to parse a date string, store those values in c XIDATE common. include 'comdtc.inc/nolist' include 'dtcxidate.inc/nolist' include 'defcentry.inc/list' byte ln1 equivalence (line, ln1) call shrink(1, ifnb, ilnb) ! Unload command character if (ln1 .eq. 0) 1 then call idate (xim, xid, xiy) ! Reset xibgyr = icntry + xiy ! Set long value ibigyr = xibgyr ! Set values into common idmo = xim iddy = xid idyr = xiy else call dtcdatcvt (3) ! Parse string xim = idmo ! Set test values xid = iddy xiy = idyr xibgyr = ibigyr end if end