Fortran 流程控制（一）：where

自学气象人

发布于 2023-06-20 16:43:25

3530

发布于 2023-06-20 16:43:25

现代Fortran语言中面向数组的特征包含两类特定的流程控制结构。我们都知道，对于标量而言，可以通过使用if，case和do产生更加紧凑的代码。对于数组而言，where、forall以及do concurrent结构可以用来简化数组表达，并能避免手动扩展表达式的麻烦。作为一般说明，这些结构都可以被命名或者嵌套。下面先简要介绍下where结构。

where结构

where结构可以用来将数组赋值限制为仅给满足给定条件的元素赋值，也被称为masked array assignment。在许多方面，它等价于一种面向数组的if结构，而if结构本身是面向标量的。

基本格式

where( <logicalArray > ) 
    array1 = <array_expression1 > 
    array2 = <array_expression2 > 
    ... 
end where

其中，logicalArray是一个逻辑表达式，其与array1和array2等等必须有相同的大小。与if以及elseif结构类似，where结构也有的紧凑格式以及elsewhere结构：

! ** Compact format **
where( <logicalArray > )array1 = <array_expression1 > 

! ** Elsewhere construct **
! ** 2-branches **
where( <logicalArray1 > )
    array1 = <array_expression1 >  
elsewhere( <logicalArray2 > ) 
    array2 = <array_expression2 >
end where
! ** multi-branches **
where( <logicalArray1 > )
      array1 = <array_expression1 > 
elsewhere( <logicalArray2 > )
      array2 = <array_expression2 >
elsewhere
      array3 = <array_expression3 >
end where

Example

program where_construct1
  implicit none
  integer, parameter :: N = 5
  character(len=100) :: outFormat
  integer :: i, j
  real :: a(N,N) = 0, b(N,N) = 0, threshold = 0.5, &
       c(N,N) = 0, d(N,N) = 0 ! used in next examples

  ! write some values in a
  call random_number( a )

  ! Create dynamic format, with internal-file(=string) outFormat.
  ! This way, the format is adjusted automatically if N changes.
  write(outFormat, *) "(", N, "(x, f8.2))"

  write(*, '(a)') "a = "
  write(*, fmt=outFormat) &
       ( (a(i,j), j=1,N), i=1,N )
  
  ! ** Masked array-assignment **
  where( a > threshold )
     b = a
  elsewhere( a < threshold/2 )
     c = a
  elsewhere
     d = a
  end where

  write(*, '(/,a)') "b (after masked assignment) = "
  write(*, fmt=outFormat) ( (b(i,j), j=1,N), i=1,N )

  write(*, '(/,a)') "c (after masked assignment) = "
  write(*, fmt=outFormat) ( (c(i,j), j=1,N), i=1,N )

  write(*, '(/,a)') "d (after masked assignment) = "
  write(*, fmt=outFormat) ( (d(i,j), j=1,N), i=1,N )

end program where_construct1

输出：

a = 
     0.00     0.92     0.70     0.09     0.85     0.75     0.99
     0.03     0.80     0.73     0.56     0.12     0.22     0.59
     0.35     0.83     0.30     0.93     0.99     0.66     0.77
     0.67     0.35     0.05     0.08     0.78     0.54     0.44
     0.96     0.87     0.91     0.91     0.02     0.48     0.71
     0.84     0.09     0.10     0.09     0.17     0.84     0.79
     0.34     0.89     0.04     0.64     0.99     0.03     0.44

b (after masked assignment) = 
     0.00     0.92     0.70     0.00     0.85     0.75     0.99
     0.00     0.80     0.73     0.56     0.00     0.00     0.59
     0.00     0.83     0.00     0.93     0.99     0.66     0.77
     0.67     0.00     0.00     0.00     0.78     0.54     0.00
     0.96     0.87     0.91     0.91     0.00     0.00     0.71
     0.84     0.00     0.00     0.00     0.00     0.84     0.79
     0.00     0.89     0.00     0.64     0.99     0.00     0.00

c (after masked assignment) = 
     0.00     0.00     0.00     0.09     0.00     0.00     0.00
     0.03     0.00     0.00     0.00     0.12     0.22     0.00
     0.00     0.00     0.00     0.00     0.00     0.00     0.00
     0.00     0.00     0.05     0.08     0.00     0.00     0.00
     0.00     0.00     0.00     0.00     0.02     0.00     0.00
     0.00     0.09     0.10     0.09     0.17     0.00     0.00
     0.00     0.00     0.04     0.00     0.00     0.03     0.00

d (after masked assignment) = 
     0.00     0.00     0.00     0.00     0.00     0.00     0.00
     0.00     0.00     0.00     0.00     0.00     0.00     0.00
     0.35     0.00     0.30     0.00     0.00     0.00     0.00
     0.00     0.35     0.00     0.00     0.00     0.00     0.44
     0.00     0.00     0.00     0.00     0.00     0.48     0.00
     0.00     0.00     0.00     0.00     0.00     0.00     0.00
     0.34     0.00     0.00     0.00     0.00     0.00     0.44