| ! { dg-do compile } |
| ! { dg-require-effective-target pthread } |
| ! { dg-options "-Ofast -ftree-parallelize-loops=4" } |
| |
| SUBROUTINE wsm32D(t, & |
| w, & |
| den, & |
| p, & |
| delz, & |
| its,& |
| ite, & |
| kts, & |
| kte & |
| ) |
| REAL, DIMENSION( its:ite , kts:kte ), & |
| INTENT(INOUT) :: & |
| t |
| REAL, DIMENSION( ims:ime , kms:kme ), & |
| INTENT(IN ) :: w, & |
| den, & |
| p, & |
| delz |
| REAL, DIMENSION( its:ite , kts:kte ) :: & |
| qs, & |
| xl, & |
| work1, & |
| work2, & |
| qs0, & |
| n0sfac |
| diffus(x,y) = 8.794e-5*x**1.81/y |
| diffac(a,b,c,d,e) = d*a*a/(xka(c,d)*rv*c*c)+1./(e*diffus(c,b)) |
| venfac(a,b,c) = (viscos(b,c)/diffus(b,a))**(.3333333) & |
| /viscos(b,c)**(.5)*(den0/c)**0.25 |
| do loop = 1,loops |
| xa=-dldt/rv |
| do k = kts, kte |
| do i = its, ite |
| tr=ttp/t(i,k) |
| if(t(i,k).lt.ttp) then |
| qs(i,k) =psat*(tr**xa)*exp(xb*(1.-tr)) |
| endif |
| qs0(i,k) =psat*(tr**xa)*exp(xb*(1.-tr)) |
| enddo |
| do i = its, ite |
| if(t(i,k).ge.t0c) then |
| work1(i,k) = diffac(xl(i,k),p(i,k),t(i,k),den(i,k),qs(i,k)) |
| endif |
| work2(i,k) = venfac(p(i,k),t(i,k),den(i,k)) |
| enddo |
| enddo |
| enddo ! big loops |
| END SUBROUTINE wsm32D |
