* A00ADF Example Program Text * Mark 22 Release. NAG Copyright 2008. * .. Parameters .. INTEGER NOUT, MSGLEN PARAMETER (NOUT=6,MSGLEN=14) * .. Local Scalars .. INTEGER I, MKMAJ, MKMIN LOGICAL LICVAL CHARACTER*20 PCODE CHARACTER*57 IMPL, PREC CHARACTER*64 FCOMP, HDWARE, OPSYS, VEND * .. Local Arrays .. INTEGER ITIME(7) CHARACTER*80 MSG(MSGLEN) * .. External Subroutines .. EXTERNAL A00ADF, X04BAF, X05AAF * .. Executable Statements .. WRITE (NOUT,*) 'A00ADF Example Program Results' WRITE (NOUT,*) * CALL A00ADF(IMPL,PREC,PCODE,MKMAJ,MKMIN,HDWARE,OPSYS,FCOMP,VEND, + LICVAL) * * Print implementation details. * MSG(1) = ' *** Start of NAG Library implementation details ***' MSG(2) = ' ' MSG(3) = ' Implementation title: '//IMPL MSG(4) = ' Precision: '//PREC MSG(5) = ' Product Code: '//PCODE IF (MKMIN.LT.10) THEN WRITE (MSG(6),99999) MKMAJ, MKMIN ELSE WRITE (MSG(6),99998) MKMAJ, MKMIN END IF IF (VEND.EQ.'(self-contained)') THEN MSG(7) = ' Vendor Library: None' ELSE MSG(7) = ' Vendor Library: '//VEND END IF MSG(8) = ' Applicable to:' MSG(9) = ' hardware - '//HDWARE MSG(10) = ' op. sys. - '//OPSYS MSG(11) = ' compiler - '//FCOMP MSG(12) = ' and compatible systems.' MSG(13) = ' ' MSG(14) = ' *** End of NAG Library implementation details ***' * DO 20 I = 1, MSGLEN CALL X04BAF(NOUT,MSG(I)) 20 CONTINUE * * Print whether valid licence was found for this product. * WRITE (NOUT,*) IF (LICVAL) THEN WRITE (NOUT,*) ' A valid licence was found for '//PCODE ELSE WRITE (NOUT,*) ' ** A valid licence was not found for '//PCODE END IF * * Print the date. * WRITE (NOUT,*) WRITE (NOUT,*) ' This program was run on the following date:' CALL X05AAF(ITIME) * WRITE (NOUT,99997) ' Year : ', ITIME(1) WRITE (NOUT,99997) ' Month : ', ITIME(2) WRITE (NOUT,99997) ' Day : ', ITIME(3) * WRITE (NOUT,*) '*** ----------------------------------------- ***' * 99999 FORMAT (' Mark: ',I2,'.',I1,1X,A) 99998 FORMAT (' Mark: ',I2,'.',I2,1X,A) 99997 FORMAT (1X,A,I4) END