random code 3: first look at FORTRAN

:: CodeCritic, Programming Languages

By: John Clements

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
  !================================================================================================================================
  !

  !>Initialises the interpolated point metrics for an interpolated point.
  SUBROUTINE FIELD_INTERPOLATED_POINT_METRICS_INITIALISE(INTERPOLATED_POINT,INTERPOLATED_POINT_METRICS,ERR,ERROR,*)

    !Argument variables
    TYPE(FIELD_INTERPOLATED_POINT_TYPE), POINTER :: INTERPOLATED_POINT !A pointer to the interpolated point to initliase the interpolated point metrics for
    TYPE(FIELD_INTERPOLATED_POINT_METRICS_TYPE), POINTER :: INTERPOLATED_POINT_METRICS !<On exit, a pointer to the interpolated point metrics that have been initialised
    INTEGER(INTG), INTENT(OUT) :: ERR !<The error code
    TYPE(VARYING_STRING), INTENT(OUT) :: ERROR !<The error string
    !Local Variables
    INTEGER(INTG) :: NUMBER_OF_XI_DIMENSIONS,NUMBER_OF_X_DIMENSIONS
    INTEGER(INTG) :: DUMMY_ERR
    TYPE(COORDINATE_SYSTEM_TYPE), POINTER :: COORDINATE_SYSTEM
    TYPE(VARYING_STRING) :: DUMMY_ERROR,LOCAL_ERROR

    CALL ENTERS("FIELD_INTERPOLATED_POINT_METRICS_INITIALISE",ERR,ERROR,*999)

    IF(ASSOCIATED(INTERPOLATED_POINT)) THEN
      IF(ASSOCIATED(INTERPOLATED_POINT_METRICS)) THEN
        CALL FLAG_ERROR("Interpolated point metrics is already associated.",ERR,ERROR,*998)
      ELSE
        NULLIFY(COORDINATE_SYSTEM)
        CALL FIELD_COORDINATE_SYSTEM_GET(INTERPOLATED_POINT%INTERPOLATION_PARAMETERS%FIELD,COORDINATE_SYSTEM,ERR,ERROR,*999)
        NUMBER_OF_X_DIMENSIONS=COORDINATE_SYSTEM%NUMBER_OF_DIMENSIONS
        NUMBER_OF_XI_DIMENSIONS=INTERPOLATED_POINT%INTERPOLATION_PARAMETERS%FIELD%DECOMPOSITION%MESH%NUMBER_OF_DIMENSIONS
        IF(NUMBER_OF_X_DIMENSIONS==SIZE(INTERPOLATED_POINT%VALUES,1)) THEN
          ALLOCATE(INTERPOLATED_POINT_METRICS,STAT=ERR)
          IF(ERR/=0) CALL FLAG_ERROR("Could not allocate interpolated point metrics.",ERR,ERROR,*999)
          ALLOCATE(INTERPOLATED_POINT_METRICS%GL(NUMBER_OF_XI_DIMENSIONS,NUMBER_OF_XI_DIMENSIONS),STAT=ERR)
          IF(ERR/=0) CALL FLAG_ERROR("Could not allocate interpolated point metrics convariant tensor.",ERR,ERROR,*999)
          ALLOCATE(INTERPOLATED_POINT_METRICS%GU(NUMBER_OF_XI_DIMENSIONS,NUMBER_OF_XI_DIMENSIONS),STAT=ERR)
          IF(ERR/=0) CALL FLAG_ERROR("Could not allocate interpolated point metrics contravariant tensor.",ERR,ERROR,*999)
          ALLOCATE(INTERPOLATED_POINT_METRICS%DX_DXI(NUMBER_OF_X_DIMENSIONS,NUMBER_OF_XI_DIMENSIONS),STAT=ERR)
          IF(ERR/=0) CALL FLAG_ERROR("Could not allocate interpolated point metrics dX_dXi.",ERR,ERROR,*999)
          ALLOCATE(INTERPOLATED_POINT_METRICS%DXI_DX(NUMBER_OF_XI_DIMENSIONS,NUMBER_OF_X_DIMENSIONS),STAT=ERR)
          IF(ERR/=0) CALL FLAG_ERROR("Could not allocate interpolated point metrics dXi_dX.",ERR,ERROR,*999)
          INTERPOLATED_POINT_METRICS%INTERPOLATED_POINT=>INTERPOLATED_POINT
          INTERPOLATED_POINT_METRICS%NUMBER_OF_X_DIMENSIONS=NUMBER_OF_X_DIMENSIONS
          INTERPOLATED_POINT_METRICS%NUMBER_OF_XI_DIMENSIONS=NUMBER_OF_XI_DIMENSIONS
          INTERPOLATED_POINT_METRICS%GL=0.0_DP
          INTERPOLATED_POINT_METRICS%GU=0.0_DP
          INTERPOLATED_POINT_METRICS%DX_DXI=0.0_DP
          INTERPOLATED_POINT_METRICS%DXI_DX=0.0_DP
          INTERPOLATED_POINT_METRICS%JACOBIAN=0.0_DP
          INTERPOLATED_POINT_METRICS%JACOBIAN_TYPE=0
        ELSE
          LOCAL_ERROR="The number of coordinate dimensions ("//TRIM(NUMBER_TO_VSTRING(NUMBER_OF_X_DIMENSIONS,"*",ERR,ERROR))// &
            & ") does not match the number of components of the interpolated point ("// &
            & TRIM(NUMBER_TO_VSTRING(SIZE(INTERPOLATED_POINT%VALUES,1),"*",ERR,ERROR))//")."
          CALL FLAG_ERROR(LOCAL_ERROR,ERR,ERROR,*998)
        ENDIF
      ENDIF
    ELSE
      CALL FLAG_ERROR("Interpolation point is not associated.",ERR,ERROR,*998)
    ENDIF

    CALL EXITS("FIELD_INTERPOLATED_POINT_METRICS_INITIALISE")
    RETURN
999 CALL FIELD_INTERPOLATED_POINT_METRICS_FINALISE(INTERPOLATED_POINT_METRICS,DUMMY_ERR,DUMMY_ERROR,*998)
998 CALL ERRORS("FIELD_INTERPOLATED_POINT_METRICS_INITIALISE",ERR,ERROR)
    CALL EXITS("FIELD_INTERPOLATED_POINT_METRICS_INITIALISE")
    RETURN 1
  END SUBROUTINE FIELD_INTERPOLATED_POINT_METRICS_INITIALISE

Ever taken a look at FORTRAN? Actually, I haven’t, either. FORTRAN is basically the oldest non-assembly language around, which is to say the oldest language where someone actually considered “what would programmers like to say?”, rather than “what should the machine be able to do?”

Also, this is FORTRAN 90, which is a much more recent update of FORTRAN. After a quick reading of the Wikipedia page, it looks like f90 (I’m just tired of writing in all caps) is the first update since 1977, which seems ancient but is in fact about halfway between the first invention of FORTRAN and the present day.

It removes many of the restrictions due to machine limitations (allowing free-form source code), and also allows recursive calls, something that the original FORTRAN didn’t—life is easy when you can statically allocate your stack frames!

It also has modules, and… gee whiz: dynamic allocation? Interesting: sounds like it would be much harder to compile f90 code into super-fast assembly than f77, but I suppose you’d have to ask an expert.

Hmmm… I wonder if there’s a formal semantics for more recent versions of Fortran 90? A quick google search suggests the answer is “no”. On the other hand, I’m not sure who would be interested in such a thing; you might be able to sell it as “this formal semantics could identify bugs in your optimization routines”. Anyone want to pay for this?

Okay, back to the source code. What’s going on here?

The first and most obvious thing here is that F90 clearly has a tradition of LONG_CAPITALIZED_VARIABLE_NAMES. COBOL had this going on too, and also an undergraduate classmate of mine named Celeste (RIP, no joke).

I personally find this fairly distracting; it means that a line of source code can’t contain more than two or three tokens, and means that computations have to be split over a whole bunch of lines. On the other hand, local variables apparently have to be declared at the top, so it’s hard to split a large computation into small ones by giving good names to intermediate values.

I think there’s a fairly large split in the world between people who believe that variables should be declared at the top of functions and those who believe that they should be able to appear anywhere; I think that the decls-only-at-top people are imperative people who are planning on doing all kinds of horrible mutation everywhere, and declaring things at the top is their way of preparing themselves for the horror below. The decls-anywhere people (can you tell which I am?), on the other hand, don’t mutate their bindings; these bindings are just a way of giving meaningful names to parts of computation, and there’s no need to hoist them all to the top.

So F90 has the pull toward decls-anywhere that stems from long identifier names, but it’s used by super-imperative people. How do they get any work done? Okay, now I’m just being snide. Sorry. I should point out here that Fortran is clearly one of the massive success stories of language design; it’s one of the first languages, and still in hugely widespread use, thanks in large part to the total 90-degree turn taken by the scientific computing community into C, which is simultaneously the fastest and least optimizable/maintainable language. See Fran Allen’s comments here! Sorry, off topic.

Other, more minor comments: the error-checking code following the dynamic allocation looks like it could easily be abstracted away, especially considering that the error messages aren’t parameterized over the context in any way that I can see.

Broadly speaking, I think I would make local declarations legal anywhere, and shorten up those variable names. Otherwise, looks nice!