gcc/testsuite/gfortran.dg/pr79315.f90

   1 ! { dg-do compile }
   2 ! { dg-require-effective-target pthread }
   3 ! { dg-options "-Ofast -ftree-parallelize-loops=4" }
   4
   5 SUBROUTINE wsm32D(t, &
   6    w, &
   7    den, &
   8    p, &
   9    delz, &
  10                      its,&
  11    ite, &
  12    kts, &
  13    kte  &
  14                       )
  15   REAL, DIMENSION( its:ite , kts:kte ),                           &
  16         INTENT(INOUT) ::                                          &
  17                                                                t
  18   REAL, DIMENSION( ims:ime , kms:kme ),                           &
  19         INTENT(IN   ) ::                                       w, &
  20                                                              den, &
  21                                                                p, &
  22                                                             delz
  23   REAL, DIMENSION( its:ite , kts:kte ) ::                         &
  24         qs, &
  25         xl, &
  26         work1, &
  27         work2, &
  28         qs0, &
  29         n0sfac
  30       diffus(x,y) = 8.794e-5*x**1.81/y
  31       diffac(a,b,c,d,e) = d*a*a/(xka(c,d)*rv*c*c)+1./(e*diffus(c,b))
  32       venfac(a,b,c) = (viscos(b,c)/diffus(b,a))**(.3333333)       &
  33              /viscos(b,c)**(.5)*(den0/c)**0.25
  34       do loop = 1,loops
  35       xa=-dldt/rv
  36       do k = kts, kte
  37         do i = its, ite
  38           tr=ttp/t(i,k)
  39           if(t(i,k).lt.ttp) then
  40             qs(i,k) =psat*(tr**xa)*exp(xb*(1.-tr))
  41           endif
  42           qs0(i,k)  =psat*(tr**xa)*exp(xb*(1.-tr))
  43         enddo
  44         do i = its, ite
  45           if(t(i,k).ge.t0c) then
  46             work1(i,k) = diffac(xl(i,k),p(i,k),t(i,k),den(i,k),qs(i,k))
  47           endif
  48           work2(i,k) = venfac(p(i,k),t(i,k),den(i,k))
  49         enddo
  50       enddo
  51       enddo                  ! big loops
  52 END SUBROUTINE wsm32D