|
111
|
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
|
