File: pr79315.f90

package info (click to toggle)
gcc-arm-none-eabi 15%3A12.2.rel1-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 959,712 kB
  • sloc: cpp: 3,275,382; ansic: 2,061,766; ada: 840,956; f90: 208,513; makefile: 76,132; asm: 73,433; xml: 50,448; exp: 34,146; sh: 32,436; objc: 15,637; fortran: 14,012; python: 11,991; pascal: 6,787; awk: 4,779; perl: 3,054; yacc: 338; ml: 285; lex: 201; haskell: 122
file content (52 lines) | stat: -rw-r--r-- 1,743 bytes parent folder | download | duplicates (2) 
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
 
! { 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