{"id":1864,"date":"2013-01-07T17:38:07","date_gmt":"2013-01-07T16:38:07","guid":{"rendered":"http:\/\/www.walkingrandomly.com\/?p=1864"},"modified":"2013-01-07T17:47:15","modified_gmt":"2013-01-07T16:47:15","slug":"the-nag-fortran-compiler-fortran-builder-and-a-fortran-quiz","status":"publish","type":"post","link":"https:\/\/walkingrandomly.com\/?p=1864","title":{"rendered":"The NAG Fortran Compiler, Fortran Builder and a Fortran quiz"},"content":{"rendered":"

The\u00a0Numerical Algorithms Group<\/a>\u00a0(NAG) are\u00a0principally known for their numerical library<\/a> but they also offer products such as a MATLAB toolbox and a Fortran compiler. \u00a0My employer, The University of Manchester<\/a>, has \u00a0a full site license for most of NAG’s stuff where it is heavily used by both our students and researchers.<\/p>\n

While at a recent software conference, I saw a talk by NAG’s\u00a0David Sayers<\/a>\u00a0where he demonstrated some of the features of the NAG Fortran Compiler<\/a>. \u00a0During this talk he showed some examples of broken Fortran and asked us if we could spot how they were broken without compiler assistance. \u00a0I enjoyed the talk and so asked David if he would mind writing a guest blog post on the subject for WalkingRandomly. \u00a0He duly obliged.<\/p>\n

\u00a0This is a guest blog post by David Sayers<\/a> of NAG.<\/strong><\/p>\n

What do you want from your Fortran compiler? Some people ask for extra (non-standard) features, others require very fast execution speed. The very latest extensions to the Fortran language appeal to those who like to be up to date with their code.<\/p>\n

I suspect that very few would put enforcement of the Fortran standard<\/strong> at the top of their list, yet this essential if problems are to be avoided in the future. Code written specifically for one compiler is unlikely to work when computers change, or may contain errors that appear only intermittently. Without access to at least one good checking compiler, the developer or support desk will be lacking a valuable tool in the fight against faulty code.<\/p>\n

The NAG Fortran compiler is such a tool. It is used extensively by NAG’s own staff to validate their library code and to answer user-support queries involving user’s Fortran programs. It is available on Windows, where it has its own IDE called Fortran Builder,\u00a0and on Unix platforms and Mac OS X.<\/p>\n

Windows users also have the benefit of some Fortran Tools bundled in to the IDE. Particularly nice is the Fortran polisher which tidies up the presentation of your source files according to user-specified preferences.<\/p>\n

The compiler includes most Fortran 2003 features, very many Fortran 2008 features and the most commonly used features of OpenMP 3.0 are supported.<\/p>\n

The principal developer of the compiler is Malcolm Cohen<\/a>, co-author of the book, Modern Fortran Explained<\/a>\"\" along with Michael Metcalf\u00a0and John Reid. Malcolm has been a member of the international working group on Fortran, ISO\/IEC JTC1\/SC22\/WG5, since 1988,\u00a0and the USA technical subcommittee on Fortran, J3, since 1994. He has been head of the J3 \/DATA subgroup since 1998 and was\u00a0responsible for the design and development of the object-oriented features in Fortran 2003. Since 2005 he has been Project\u00a0Editor for the ISO\/IEC Fortran standard, which has continued its evolution with the publication of the Fortran 2008 standard\u00a0in 2010.<\/p>\n

Of all people Malcolm Cohen should know Fortran and the way the standard should be enforced!<\/p>\n

His compiler reflects that knowledge and is designed to assist the programmer to detect how programs might be faulty due to a departure from the Fortran standard or prone to trigger a run time error. In either case the diagnostics of produced by the compiler are clear and helpful and can save the developer many hours of laborious bug-tracing. Here are some particularly simple examples of faulty programs. See if you can spot the mistakes, and think how difficult these might be to detect in programs that may be thousands of times longer:<\/p>\n

Example 1<\/strong><\/p>\n

    Program test\r\n      Real, Pointer :: x(:, :)\r\n\r\n      Call make_dangle\r\n      x(10, 10) = 0\r\n    Contains\r\n      Subroutine make_dangle\r\n        Real, Target :: y(100, 200)\r\n\r\n        x => y\r\n      End Subroutine make_dangle\r\n    End Program test<\/pre>\n
Example 2<\/strong><\/p>\n
Program dangle2\r\nReal,Pointer :: x(:),y(:)\r\nAllocate(x(100))\r\ny => x\r\nDeallocate(x)\r\ny = 3\r\nEnd<\/pre>\n
Example 3<\/strong><\/p>\n
      program more\r\n      integer n, i\r\n      real r, s\r\n      equivalence (n,r)\r\n      i=3\r\n      r=2.5\r\n      i=n*n\r\n      write(6,900) i, r\r\n900  format(' i = ', i5, '   r = ', f10.4)\r\n      stop 'ok'\r\n      end<\/pre>\n
Example 4<\/strong><\/p>\n
      program trouble1\r\n      integer n\r\n      parameter (n=11)\r\n      integer iarray(n) \r\n      integer i\r\n      do 10 i=1,10\r\n        iarray(i) = i\r\n10   continue\r\n      write(6,900) iarray\r\n900  format(' iarray = ',11i5)\r\n      stop 'ok'\r\n      end<\/pre>\n
And finally if this is all too easy …<\/p>\n
Example 5<\/strong><\/p>\n
!   E04UCA Example Program Text\r\n!   Mark 23 Release. NAG Copyright 2011.\r\n\r\n    MODULE e04ucae_mod\r\n\r\n!      E04UCA Example Program Module:\r\n!             Parameters and User-defined Routines\r\n\r\n!      .. Use Statements ..\r\n       USE nag_library, ONLY : nag_wp\r\n!      .. Implicit None Statement ..\r\n       IMPLICIT NONE\r\n!      .. Parameters ..\r\n       REAL (KIND=nag_wp), PARAMETER       :: one = 1.0_nag_wp\r\n       REAL (KIND=nag_wp), PARAMETER       :: zero = 0.0_nag_wp\r\n       INTEGER, PARAMETER                  :: inc1 = 1, lcwsav = 1,            &\r\n                                              liwsav = 610, llwsav = 120,      &\r\n                                              lrwsav = 475, nin = 5, nout = 6\r\n    CONTAINS\r\n       SUBROUTINE objfun(mode,n,x,objf,objgrd,nstate,iuser,ruser)\r\n!         Routine to evaluate objective function and its 1st derivatives.\r\n\r\n!         .. Implicit None Statement ..\r\n          IMPLICIT NONE\r\n!         .. Scalar Arguments ..\r\n          REAL (KIND=nag_wp), INTENT (OUT)    :: objf\r\n          INTEGER, INTENT (INOUT)             :: mode\r\n          INTEGER, INTENT (IN)                :: n, nstate\r\n!         .. Array Arguments ..\r\n          REAL (KIND=nag_wp), INTENT (INOUT)  :: objgrd(n), ruser(*)\r\n          REAL (KIND=nag_wp), INTENT (IN)     :: x(n)\r\n          INTEGER, INTENT (INOUT)             :: iuser(*)\r\n!         .. Executable Statements ..\r\n          IF (mode==0 .OR. mode==2) THEN\r\n             objf = x(1)*x(4)*(x(1)+x(2)+x(3)) + x(3)\r\n          END IF\r\n\r\n          IF (mode==1 .OR. mode==2) THEN\r\n             objgrd(1) = x(4)*(x(1)+x(1)+x(2)+x(3))\r\n             objgrd(2) = x(1)*x(4)\r\n             objgrd(3) = x(1)*x(4) + one\r\n             objgrd(4) = x(1)*(x(1)+x(2)+x(3))\r\n          END IF\r\n\r\n          RETURN\r\n\r\n       END SUBROUTINE objfun\r\n       SUBROUTINE confun(mode,ncnln,n,ldcj,needc,x,c,cjac,nstate,iuser,ruser)\r\n!         Routine to evaluate the nonlinear constraints and their 1st\r\n!         derivatives.\r\n\r\n!         .. Implicit None Statement ..\r\n          IMPLICIT NONE\r\n!         .. Scalar Arguments ..\r\n          INTEGER, INTENT (IN)                :: ldcj, n, ncnln, nstate\r\n          INTEGER, INTENT (INOUT)             :: mode\r\n!         .. Array Arguments ..\r\n          REAL (KIND=nag_wp), INTENT (OUT)    :: c(ncnln)\r\n          REAL (KIND=nag_wp), INTENT (INOUT)  :: cjac(ldcj,n), ruser(*)\r\n          REAL (KIND=nag_wp), INTENT (IN)     :: x(n)\r\n          INTEGER, INTENT (INOUT)             :: iuser(*)\r\n          INTEGER, INTENT (IN)                :: needc(ncnln)\r\n!         .. Executable Statements ..\r\n          IF (nstate==1) THEN\r\n\r\n!            First call to CONFUN.  Set all Jacobian elements to zero.\r\n!            Note that this will only work when 'Derivative Level = 3'\r\n!            (the default; see Section 11.2).\r\n\r\n             cjac(1:ncnln,1:n) = zero\r\n          END IF\r\n\r\n          IF (needc(1)>0) THEN\r\n\r\n             IF (mode==0 .OR. mode==2) THEN\r\n                c(1) = x(1)**2 + x(2)**2 + x(3)**2 + x(4)**2\r\n             END IF\r\n\r\n             IF (mode==1 .OR. mode==2) THEN\r\n                cjac(1,1) = x(1) + x(1)\r\n                cjac(1,2) = x(2) + x(2)\r\n                cjac(1,3) = x(3) + x(3)\r\n                cjac(1,4) = x(4) + x(4)\r\n             END IF\r\n\r\n          END IF\r\n\r\n          IF (needc(2)>0) THEN\r\n\r\n             IF (mode==0 .OR. mode==2) THEN\r\n                c(2) = x(1)*x(2)*x(3)*x(4)\r\n             END IF\r\n\r\n             IF (mode==1 .OR. mode==2) THEN\r\n                cjac(2,1) = x(2)*x(3)*x(4)\r\n                cjac(2,2) = x(1)*x(3)*x(4)\r\n                cjac(2,3) = x(1)*x(2)*x(4)\r\n                cjac(2,4) = x(1)*x(2)*x(3)\r\n             END IF\r\n\r\n          END IF\r\n\r\n          RETURN\r\n\r\n       END SUBROUTINE confun\r\n    END MODULE e04ucae_mod\r\n    PROGRAM e04ucae\r\n\r\n!      E04UCA Example Main Program\r\n\r\n!      .. Use Statements ..\r\n       USE nag_library, ONLY : dgemv, e04uca, e04wbf, nag_wp\r\n       USE e04ucae_mod, ONLY : confun, inc1, lcwsav, liwsav, llwsav, lrwsav,   &\r\n                               nin, nout, objfun, one, zero\r\n!      .. Implicit None Statement ..\r\n!       IMPLICIT NONE\r\n!      .. Local Scalars ..\r\n      ! REAL (KIND=nag_wp)                  :: objf\r\n       INTEGER                             :: i, ifail, iter, j, lda, ldcj,    &\r\n                                              ldr, liwork, lwork, n, nclin,    &\r\n                                              ncnln, sda, sdcjac\r\n!      .. Local Arrays ..\r\n       REAL (KIND=nag_wp), ALLOCATABLE     :: a(:,:), bl(:), bu(:), c(:),      &\r\n                                              cjac(:,:), clamda(:), objgrd(:), &\r\n                                              r(:,:), work(:), x(:)\r\n       REAL (KIND=nag_wp)                  :: ruser(1), rwsav(lrwsav)\r\n       INTEGER, ALLOCATABLE                :: istate(:), iwork(:)\r\n       INTEGER                             :: iuser(1), iwsav(liwsav)\r\n       LOGICAL                             :: lwsav(llwsav)\r\n       CHARACTER (80)                      :: cwsav(lcwsav)\r\n!      .. Intrinsic Functions ..\r\n       INTRINSIC                              max\r\n!      .. Executable Statements ..\r\n       WRITE (nout,*) 'E04UCA Example Program Results'\r\n\r\n!      Skip heading in data file\r\n       READ (nin,*)\r\n\r\n       READ (nin,*) n, nclin, ncnln\r\n       liwork = 3*n + nclin + 2*ncnln\r\n       lda = max(1,nclin)\r\n\r\n       IF (nclin>0) THEN\r\n          sda = n\r\n       ELSE\r\n          sda = 1\r\n       END IF\r\n\r\n       ldcj = max(1,ncnln)\r\n\r\n       IF (ncnln>0) THEN\r\n          sdcjac = n\r\n       ELSE\r\n          sdcjac = 1\r\n       END IF\r\n\r\n       ldr = n\r\n\r\n       IF (ncnln==0 .AND. nclin>0) THEN\r\n          lwork = 2*n**2 + 20*n + 11*nclin\r\n       ELSE IF (ncnln>0 .AND. nclin>=0) THEN\r\n          lwork = 2*n**2 + n*nclin + 2*n*ncnln + 20*n + 11*nclin + 21*ncnln\r\n       ELSE\r\n          lwork = 20*n\r\n       END IF\r\n\r\n       ALLOCATE (istate(n+nclin+ncnln),iwork(liwork),a(lda,sda), &\r\n          bl(n+nclin+ncnln),bu(n+nclin+ncnln),c(max(1, &\r\n          ncnln)),cjac(ldcj,sdcjac),clamda(n+nclin+ncnln),objgrd(n),r(ldr,n), &\r\n          x(n),work(lwork))\r\n\r\n       IF (nclin>0) THEN\r\n          READ (nin,*) (a(i,1:sda),i=1,nclin)\r\n       END IF\r\n\r\n       READ (nin,*) bl(1:(n+nclin+ncnln))\r\n       READ (nin,*) bu(1:(n+nclin+ncnln))\r\n       READ (nin,*) x(1:n)\r\n\r\n!      Initialise E04UCA\r\n\r\n       ifail = 0\r\n       CALL e04wbf('E04UCA',cwsav,lcwsav,lwsav,llwsav,iwsav,liwsav,rwsav, &\r\n          lrwsav,ifail)\r\n\r\n!      Solve the problem\r\n\r\n       ifail = -1\r\n       CALL e04uca(n,nclin,ncnln,lda,ldcj,ldr,a,bl,bu,confun,objfun,iter, &\r\n          istate,c,cjac,clamda,objf,objgrd,r,x,iwork,liwork,work,lwork,iuser, &\r\n          ruser,lwsav,iwsav,rwsav,ifail)\r\n\r\n       SELECT CASE (ifail)\r\n       CASE (0:6,8)\r\n          WRITE (nout,*)\r\n          WRITE (nout,99999)\r\n          WRITE (nout,*)\r\n\r\n          DO i = 1, n\r\n             WRITE (nout,99998) i, istate(i), x(i), clamda(i)\r\n          END DO\r\n\r\n          IF (nclin>0) THEN\r\n\r\n!            A*x --> work.\r\n!            The NAG name equivalent of dgemv is f06paf\r\n             CALL dgemv('N',nclin,n,one,a,lda,x,inc1,zero,work,inc1)\r\n\r\n             WRITE (nout,*)\r\n             WRITE (nout,*)\r\n             WRITE (nout,99997)\r\n             WRITE (nout,*)\r\n\r\n             DO i = n + 1, n + nclin\r\n                j = i - n\r\n                WRITE (nout,99996) j, istate(i), work(j), clamda(i)\r\n             END DO\r\n\r\n          END IF\r\n\r\n          IF (ncnln>0) THEN\r\n             WRITE (nout,*)\r\n             WRITE (nout,*)\r\n             WRITE (nout,99995)\r\n             WRITE (nout,*)\r\n\r\n             DO i = n + nclin + 1, n + nclin + ncnln\r\n                j = i - n - nclin\r\n                WRITE (nout,99994) j, istate(i), c(j), clamda(i)\r\n             END DO\r\n\r\n          END IF\r\n\r\n          WRITE (nout,*)\r\n          WRITE (nout,*)\r\n          WRITE (nout,99993) objf\r\n       END SELECT\r\n\r\n99999  FORMAT (1X,'Varbl',2X,'Istate',3X,'Value',9X,'Lagr Mult')\r\n99998  FORMAT (1X,'V',2(1X,I3),4X,1P,G14.6,2X,1P,G12.4)\r\n99997  FORMAT (1X,'L Con',2X,'Istate',3X,'Value',9X,'Lagr Mult')\r\n99996  FORMAT (1X,'L',2(1X,I3),4X,1P,G14.6,2X,1P,G12.4)\r\n99995  FORMAT (1X,'N Con',2X,'Istate',3X,'Value',9X,'Lagr Mult')\r\n99994  FORMAT (1X,'N',2(1X,I3),4X,1P,G14.6,2X,1P,G12.4)\r\n99993  FORMAT (1X,'Final objective value = ',1P,G15.7)\r\n    END PROGRAM e04ucae<\/pre>\n
Answers to this particular New Year quiz will be posted in a future blog post.<\/p>\n","protected":false},"excerpt":{"rendered":"
The\u00a0Numerical Algorithms Group\u00a0(NAG) are\u00a0principally known for their numerical library but they also offer products such as a MATLAB toolbox and a Fortran compiler. \u00a0My employer, The University of Manchester, has \u00a0a full site license for most of NAG’s stuff where it is heavily used by both our students and researchers. While at a recent software […]<\/p>\n","protected":false},"author":3,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"footnotes":"","jetpack_publicize_message":"","jetpack_publicize_feature_enabled":true,"jetpack_social_post_already_shared":false,"jetpack_social_options":{"image_generator_settings":{"template":"highway","default_image_id":0,"font":"","enabled":false},"version":2},"jetpack_post_was_ever_published":false},"categories":[34,49,28,7],"tags":[],"class_list":["post-1864","post","type-post","status-publish","format-standard","hentry","category-fortran","category-guest-posts","category-nag-library","category-programming"],"jetpack_publicize_connections":[],"jetpack_shortlink":"https:\/\/wp.me\/p3swhs-u4","jetpack_sharing_enabled":true,"jetpack_featured_media_url":"","_links":{"self":[{"href":"https:\/\/walkingrandomly.com\/index.php?rest_route=\/wp\/v2\/posts\/1864","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/walkingrandomly.com\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/walkingrandomly.com\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/walkingrandomly.com\/index.php?rest_route=\/wp\/v2\/users\/3"}],"replies":[{"embeddable":true,"href":"https:\/\/walkingrandomly.com\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=1864"}],"version-history":[{"count":13,"href":"https:\/\/walkingrandomly.com\/index.php?rest_route=\/wp\/v2\/posts\/1864\/revisions"}],"predecessor-version":[{"id":4755,"href":"https:\/\/walkingrandomly.com\/index.php?rest_route=\/wp\/v2\/posts\/1864\/revisions\/4755"}],"wp:attachment":[{"href":"https:\/\/walkingrandomly.com\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=1864"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/walkingrandomly.com\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=1864"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/walkingrandomly.com\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=1864"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}