nilyin
/
wrf-python
forked from 3rdparty/wrf-python
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

Set the fortran OpenMP code to use the runtime scheduler so that it can be controlled inside of Python.

lon0
Bill Ladwig 7 years ago
parent
f5bc875627
commit
7353aca4bd
13 changed files with 59 additions and 50 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 4
      fortran/calc_uh.f90
  2. 3
      fortran/eqthecalc.f90
  3. 10
      fortran/rip_cape.f90
  4. 6
      fortran/wrf_cloud_fracf.f90
  5. 6
      fortran/wrf_fctt.f90
  6. 4
      fortran/wrf_pvo.f90
  7. 2
      fortran/wrf_pw.f90
  8. 2
      fortran/wrf_relhl.f90
  9. 7
      fortran/wrf_rip_phys_routines.f90
  10. 48
      fortran/wrf_user.f90
  11. 6
      fortran/wrf_user_dbz.f90
  12. 7
      fortran/wrf_vinterp.f90
  13. 4
      fortran/wrf_wind.f90

4
fortran/calc_uh.f90
Unescape View File

@ -64,7 +64,7 @@ SUBROUTINE DCALCUH(nx, ny, nz, nzp1, zp, mapfct, dx, dy, uhmnhgt, uhmxhgt, us, &
!$OMP PARALLEL !$OMP PARALLEL
!$OMP DO COLLAPSE(3) !$OMP DO COLLAPSE(3) SCHEDULE(runtime)
DO k=2,nz-2 DO k=2,nz-2
DO j=2,ny-1 DO j=2,ny-1
DO i=2,nx-1 DO i=2,nx-1
@ -83,7 +83,7 @@ SUBROUTINE DCALCUH(nx, ny, nz, nzp1, zp, mapfct, dx, dy, uhmnhgt, uhmxhgt, us, &
! WRITE(6,'(a,f12.1,a,f12.1,a)') & ! WRITE(6,'(a,f12.1,a,f12.1,a)') &
! 'Calculating UH from ',uhmnhgt,' to ',uhmxhgt,' m AGL' ! 'Calculating UH from ',uhmnhgt,' to ',uhmxhgt,' m AGL'
!$OMP DO COLLAPSE(2) PRIVATE(i, j, k, zbot, ztop, kbot, ktop, & !$OMP DO COLLAPSE(2) PRIVATE(i, j, k, zbot, ztop, kbot, ktop, &
!$OMP wgtlw, wbot, wtop, wsum, wmean, sum, helbot, heltop) !$OMP wgtlw, wbot, wtop, wsum, wmean, sum, helbot, heltop) SCHEDULE(runtime)
DO j=2,ny-2 DO j=2,ny-2
DO i=2,nx-2 DO i=2,nx-2
zbot = zp(i,j,2) + uhmnhgt zbot = zp(i,j,2) + uhmnhgt

3
fortran/eqthecalc.f90
Unescape View File

@ -32,7 +32,8 @@ SUBROUTINE DEQTHECALC(qvp, tmk, prs, eth, miy, mjx, mkzh)
REAL(KIND=8) :: tlcl REAL(KIND=8) :: tlcl
INTEGER :: i, j, k INTEGER :: i, j, k
!$OMP PARALLEL DO COLLAPSE(3) PRIVATE(i, j, k, q, t, p, e, tlcl) !$OMP PARALLEL DO COLLAPSE(3) PRIVATE(i, j, k, q, t, p, e, tlcl) &
!$OMP SCHEDULE(runtime)
DO k = 1,mkzh DO k = 1,mkzh
DO j = 1,mjx DO j = 1,mjx
DO i = 1,miy DO i = 1,miy

10
fortran/rip_cape.f90
Unescape View File

@ -226,7 +226,7 @@ SUBROUTINE DPFCALC(prs, sfp, pf, mix, mjy, mkzh, ter_follow)
INTEGER :: i,j,k INTEGER :: i,j,k
!$OMP PARALLEL DO COLLAPSE(3) !$OMP PARALLEL DO COLLAPSE(3) SCHEDULE(runtime)
DO j = 1,mjy DO j = 1,mjy
DO i = 1,mix DO i = 1,mix
DO k = 1,mkzh DO k = 1,mkzh
@ -353,7 +353,7 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
! calculated the pressure at full sigma levels (a set of pressure ! calculated the pressure at full sigma levels (a set of pressure
! levels that bound the layers represented by the vertical grid points) ! levels that bound the layers represented by the vertical grid points)
!$OMP PARALLEL DO COLLAPSE(3) !$OMP PARALLEL DO COLLAPSE(3) SCHEDULE(runtime)
DO j = 1,mjy DO j = 1,mjy
DO i = 1,mix DO i = 1,mix
DO k = 1,mkzh DO k = 1,mkzh
@ -382,7 +382,7 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
!$OMP facden, tmkenv, qvpenv, eslift, qvplift, buoy, benamin, & !$OMP facden, tmkenv, qvpenv, eslift, qvplift, buoy, benamin, &
!$OMP benaccum, zrel, kmax, dz, elfound, & !$OMP benaccum, zrel, kmax, dz, elfound, &
!$OMP kel, klfc, & !$OMP kel, klfc, &
!$OMP i, j, k, kpar) !$OMP i, j, k, kpar) SCHEDULE(runtime)
DO j = 1,mjy DO j = 1,mjy
DO i = 1,mix DO i = 1,mix
cape(i,j,1) = 0.D0 cape(i,j,1) = 0.D0
@ -679,7 +679,7 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
! kg/kg (should range from 0.000 to 0.025) ! kg/kg (should range from 0.000 to 0.025)
! !
!$OMP PARALLEL DO COLLAPSE(3) !$OMP PARALLEL DO COLLAPSE(3) SCHEDULE(runtime)
DO j = 1,mjy DO j = 1,mjy
DO i = 1,mix DO i = 1,mix
DO k = 1,mkzh DO k = 1,mkzh
@ -712,7 +712,7 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
!$OMP benaccum, zrel, kmax, dz, elfound, & !$OMP benaccum, zrel, kmax, dz, elfound, &
!$OMP kel, klfc, pavg, p2, p1, totthe, totqvp, totprs, & !$OMP kel, klfc, pavg, p2, p1, totthe, totqvp, totprs, &
!$OMP i, j, k, kpar, kpar1, kpar2, qvppari, tmkpari,p, pup, pdn, q, th, & !$OMP i, j, k, kpar, kpar1, kpar2, qvppari, tmkpari,p, pup, pdn, q, th, &
!$OMP pp1, pp2, ethmax, eth_temp, klev) !$OMP pp1, pp2, ethmax, eth_temp, klev) SCHEDULE(runtime)
DO j = 1,mjy DO j = 1,mjy
DO i = 1,mix DO i = 1,mix
cape(i,j,1) = 0.D0 cape(i,j,1) = 0.D0

6
fortran/wrf_cloud_fracf.f90
Unescape View File

@ -22,7 +22,8 @@ SUBROUTINE DCLOUDFRAC(pres, rh, lowc, midc, highc, nz, ns, ew)
midc = 0 midc = 0
highc = 0 highc = 0
!$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i, j, k, kchi, kcmi, kclo) !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i, j, k, kchi, kcmi, kclo) &
!$OMP SCHEDULE(runtime)
DO j = 1,ns DO j = 1,ns
DO i = 1,ew DO i = 1,ew
DO k = 1,nz-1 DO k = 1,nz-1
@ -85,7 +86,8 @@ SUBROUTINE DCLOUDFRAC2(vert, rh, vert_inc_w_height, low_thresh, mid_thresh, &
midc = 0 midc = 0
highc = 0 highc = 0
!$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i, j, k, kchi, kcmi, kclo) !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i, j, k, kchi, kcmi, kclo) &
!$OMP SCHEDULE(runtime)
DO j = 1,ns DO j = 1,ns
DO i = 1,ew DO i = 1,ew
! A value of -1 means 'not found'. This is needed to handle ! A value of -1 means 'not found'. This is needed to handle

6
fortran/wrf_fctt.f90
Unescape View File

@ -26,7 +26,7 @@ SUBROUTINE wrfcttcalc(prs, tk, qci, qcw, qvp, ght, ter, ctt, haveqci, nz, ns, ew
!$OMP PARALLEL !$OMP PARALLEL
! Calculate the surface pressure ! Calculate the surface pressure
!$OMP DO COLLAPSE(2) !$OMP DO COLLAPSE(2) SCHEDULE(runtime)
DO j=1,ns DO j=1,ns
DO i=1,ew DO i=1,ew
ratmix = .001D0*qvp(i,j,1) ratmix = .001D0*qvp(i,j,1)
@ -40,7 +40,7 @@ SUBROUTINE wrfcttcalc(prs, tk, qci, qcw, qvp, ght, ter, ctt, haveqci, nz, ns, ew
END DO END DO
!$OMP END DO !$OMP END DO
!$OMP DO COLLAPSE(3) !$OMP DO COLLAPSE(3) SCHEDULE(runtime)
DO k=1,nz-1 DO k=1,nz-1
DO j=1,ns DO j=1,ns
DO i=1,ew DO i=1,ew
@ -52,7 +52,7 @@ SUBROUTINE wrfcttcalc(prs, tk, qci, qcw, qvp, ght, ter, ctt, haveqci, nz, ns, ew
!$OMP END DO !$OMP END DO
!$OMP DO COLLAPSE(2) PRIVATE(i, j, k, ripk, opdepthd, opdepthu, & !$OMP DO COLLAPSE(2) PRIVATE(i, j, k, ripk, opdepthd, opdepthu, &
!$OMP prsctt, dp, p1, p2, fac, arg1) !$OMP prsctt, dp, p1, p2, fac, arg1) SCHEDULE(runtime)
DO j=1,ns DO j=1,ns
DO i=1,ew DO i=1,ew
opdepthd = 0.D0 opdepthd = 0.D0

4
fortran/wrf_pvo.f90
Unescape View File

@ -24,7 +24,7 @@ SUBROUTINE DCOMPUTEABSVORT(av, u, v, msfu, msfv, msft, cor, dx, dy, nx, ny, nz,&
REAL(KIND=8) :: mm REAL(KIND=8) :: mm
!$OMP PARALLEL DO COLLAPSE(3) PRIVATE(i, j, k, jp1, jm1, ip1, im1, & !$OMP PARALLEL DO COLLAPSE(3) PRIVATE(i, j, k, jp1, jm1, ip1, im1, &
!$OMP dsx, dsy, mm, dudy, dvdx, avort) !$OMP dsx, dsy, mm, dudy, dvdx, avort) SCHEDULE(runtime)
DO k = 1,nz DO k = 1,nz
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
@ -82,7 +82,7 @@ SUBROUTINE DCOMPUTEPV(pv, u, v, theta, prs, msfu, msfv, msft, cor, dx, dy, nx, &
!$OMP PARALLEL DO COLLAPSE(3) PRIVATE(i, j, k, kp1, km1, jp1, jm1, ip1, & !$OMP PARALLEL DO COLLAPSE(3) PRIVATE(i, j, k, kp1, km1, jp1, jm1, ip1, &
!$OMP im1, dsx, dsy, mm, dudy, dvdx, avort, & !$OMP im1, dsx, dsy, mm, dudy, dvdx, avort, &
!$OMP dp, dudp, dvdp, dthdp, dthdx, dthdy) !$OMP dp, dudp, dvdp, dthdp, dthdx, dthdy) SCHEDULE(runtime)
DO k = 1,nz DO k = 1,nz
DO J = 1,ny DO J = 1,ny
DO i = 1,nx DO i = 1,nx

2
fortran/wrf_pw.f90
Unescape View File

@ -22,7 +22,7 @@ SUBROUTINE DCOMPUTEPW(p, tv, qv, ht, pw, nx, ny, nz, nzh)
!$OMP PARALLEL !$OMP PARALLEL
DO k=1,nz DO k=1,nz
!$OMP DO COLLAPSE(2) !$OMP DO COLLAPSE(2) SCHEDULE(runtime)
DO j=1,ny DO j=1,ny
DO i=1,nx DO i=1,nx
pw(i,j) = pw(i,j) + ((p(i,j,k)/(RD*tv(i,j,k)))*qv(i,j,k)*(ht(i,j,k+1) - ht(i,j,k))) pw(i,j) = pw(i,j) + ((p(i,j,k)/(RD*tv(i,j,k)))*qv(i,j,k)*(ht(i,j,k+1) - ht(i,j,k)))

2
fortran/wrf_relhl.f90
Unescape View File

@ -57,7 +57,7 @@ SUBROUTINE DCALRELHL(u, v, ght, ter, top, sreh, miy, mjx, mkzh)
!REAL(KIND=8), PARAMETER :: DTR=PI/180.d0, DPR=180.d0/PI !REAL(KIND=8), PARAMETER :: DTR=PI/180.d0, DPR=180.d0/PI
!$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i,j,k,k10,k3,ktop, cu, cv, x, & !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i,j,k,k10,k3,ktop, cu, cv, x, &
!$OMP sum, dh, sdh, su, sv, ua, va, asp, adr, bsp, bdr) !$OMP sum, dh, sdh, su, sv, ua, va, asp, adr, bsp, bdr) SCHEDULE(runtime)
DO j=1, mjx DO j=1, mjx
DO i=1, miy DO i=1, miy
sdh = 0.D0 sdh = 0.D0

7
fortran/wrf_rip_phys_routines.f90
Unescape View File

@ -79,7 +79,8 @@ SUBROUTINE WETBULBCALC(prs, tmk, qvp, twb, nx, ny, nz, psafile, errstat, errmsg)
!$OMP PARALLEL DO COLLAPSE(3) PRIVATE (i, j, k, jt, ip, q, t, p, e, tlcl, & !$OMP PARALLEL DO COLLAPSE(3) PRIVATE (i, j, k, jt, ip, q, t, p, e, tlcl, &
!$OMP eth, fracip, fracip2, fracjt, fracjt2, l1, h1, mid1, rang1, l2, h2, & !$OMP eth, fracip, fracip2, fracjt, fracjt2, l1, h1, mid1, rang1, l2, h2, &
!$OMP mid2, rang2, tonpsadiabat) REDUCTION(+:errcnt1, errcnt2) !$OMP mid2, rang2, tonpsadiabat) REDUCTION(+:errcnt1, errcnt2) &
!$OMP SCHEDULE(runtime)
DO k=1,nz DO k=1,nz
DO j=1,ny DO j=1,ny
DO i=1,nx DO i=1,nx
@ -256,7 +257,7 @@ SUBROUTINE OMGCALC(qvp, tmk, www, prs, omg, mx, my, mz)
INTEGER :: i, j, k INTEGER :: i, j, k
!REAL(KIND=8), PARAMETER :: GRAV=9.81, RGAS=287.04, EPS=0.622 !REAL(KIND=8), PARAMETER :: GRAV=9.81, RGAS=287.04, EPS=0.622
!$OMP PARALLEL DO COLLAPSE(3) !$OMP PARALLEL DO COLLAPSE(3) SCHEDULE(runtime)
DO k=1,mz DO k=1,mz
DO j=1,my DO j=1,my
DO i=1,mx DO i=1,mx
@ -318,7 +319,7 @@ SUBROUTINE VIRTUAL_TEMP(temp, ratmix, tv, nx, ny, nz)
INTEGER :: i,j,k INTEGER :: i,j,k
!REAL(KIND=8),PARAMETER :: EPS = 0.622D0 !REAL(KIND=8),PARAMETER :: EPS = 0.622D0
!$OMP PARALLEL DO COLLAPSE(3) !$OMP PARALLEL DO COLLAPSE(3) SCHEDULE(runtime)
DO k=1,nz DO k=1,nz
DO j=1,ny DO j=1,ny
DO i=1,nx DO i=1,nx

48
fortran/wrf_user.f90
Unescape View File

@ -16,7 +16,7 @@ SUBROUTINE DCOMPUTEPI(pi, pressure, nx, ny, nz)
!REAL(KIND=8), PARAMETER :: P1000MB=100000.D0, R_D=287.D0, CP=7.D0*R_D/2.D0 !REAL(KIND=8), PARAMETER :: P1000MB=100000.D0, R_D=287.D0, CP=7.D0*R_D/2.D0
!$OMP PARALLEL DO COLLAPSE(3) !$OMP PARALLEL DO COLLAPSE(3) SCHEDULE(runtime)
DO k = 1,nz DO k = 1,nz
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
@ -50,7 +50,7 @@ SUBROUTINE DCOMPUTETK(tk, pressure, theta, nx)
!REAL(KIND=8), PARAMETER :: P1000MB=100000.D0, RD=287.D0, CP=7.D0*RD/2.D0 !REAL(KIND=8), PARAMETER :: P1000MB=100000.D0, RD=287.D0, CP=7.D0*RD/2.D0
!$OMP PARALLEL DO !$OMP PARALLEL DO SCHEDULE(runtime)
DO i = 1,nx DO i = 1,nx
!pi = (pressure(i)/P1000MB)**(RD/CP) !pi = (pressure(i)/P1000MB)**(RD/CP)
!tk(i) = pi * theta(i) !tk(i) = pi * theta(i)
@ -94,7 +94,7 @@ SUBROUTINE DINTERP3DZ(data3d, out2d, zdata, desiredloc, nx, ny, nz, missingval)
END IF END IF
!$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i,j,kp,dointerp,w1,w2) & !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i,j,kp,dointerp,w1,w2) &
!$OMP FIRSTPRIVATE(ip,im) !$OMP FIRSTPRIVATE(ip,im) SCHEDULE(runtime)
DO i = 1,nx DO i = 1,nx
DO j = 1,ny DO j = 1,ny
! Initialize to missing. Was initially hard-coded to -999999. ! Initialize to missing. Was initially hard-coded to -999999.
@ -200,7 +200,8 @@ SUBROUTINE DINTERP2DXY(v3d, v2d, xy, nx, ny, nz, nxy)
INTEGER :: i, j, k, ij INTEGER :: i, j, k, ij
REAL(KIND=8) :: w11, w12, w21, w22, wx, wy REAL(KIND=8) :: w11, w12, w21, w22, wx, wy
!$OMP PARALLEL DO PRIVATE(i,j,k,ij,w11,w12,w21,w22,wx,wy) !$OMP PARALLEL DO PRIVATE(i,j,k,ij,w11,w12,w21,w22,wx,wy) &
!$OMP SCHEDULE(runtime)
DO ij = 1,nxy DO ij = 1,nxy
i = MAX(1,MIN(nx-1,INT(xy(1,ij)+1))) i = MAX(1,MIN(nx-1,INT(xy(1,ij)+1)))
j = MAX(1,MIN(ny-1,INT(xy(2,ij)+1))) j = MAX(1,MIN(ny-1,INT(xy(2,ij)+1)))
@ -252,7 +253,8 @@ SUBROUTINE DINTERP1D(v_in, v_out, z_in, z_out, vmsg, nz_in, nz_out)
im = 0 im = 0
END IF END IF
!$OMP PARALLEL DO PRIVATE(kp, k, interp, height, w1, w2) FIRSTPRIVATE(ip, im) !$OMP PARALLEL DO PRIVATE(kp, k, interp, height, w1, w2) &
!$OMP FIRSTPRIVATE(ip, im) SCHEDULE(runtime)
DO k = 1,nz_out DO k = 1,nz_out
v_out(k) = vmsg v_out(k) = vmsg
@ -344,7 +346,8 @@ SUBROUTINE DCOMPUTESEAPRS(nx, ny, nz, z, t, p, q, sea_level_pressure, &
bad_j = -1 bad_j = -1
bad_sfp = -1 bad_sfp = -1
!$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i,j,k,found) REDUCTION(+:errcnt) !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i,j,k,found) REDUCTION(+:errcnt) &
!$OMP SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
level(i,j) = -1 level(i,j) = -1
@ -382,7 +385,8 @@ SUBROUTINE DCOMPUTESEAPRS(nx, ny, nz, z, t, p, q, sea_level_pressure, &
! Get temperature PCONST Pa above surface. Use this to extrapolate ! Get temperature PCONST Pa above surface. Use this to extrapolate
! the temperature at the surface and down to sea level. ! the temperature at the surface and down to sea level.
!$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i,j,klo,khi) REDUCTION(+:errcnt) !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i,j,klo,khi) REDUCTION(+:errcnt) &
!$OMP SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
@ -426,7 +430,7 @@ SUBROUTINE DCOMPUTESEAPRS(nx, ny, nz, z, t, p, q, sea_level_pressure, &
! temperatures are *too* hot. ! temperatures are *too* hot.
IF (ridiculous_mm5_test) THEN IF (ridiculous_mm5_test) THEN
!$OMP PARALLEL DO COLLAPSE(2) PRIVATE(l1,l2,l3) !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(l1,l2,l3) SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
l1 = t_sea_level(i,j) < TC l1 = t_sea_level(i,j) < TC
@ -443,7 +447,7 @@ SUBROUTINE DCOMPUTESEAPRS(nx, ny, nz, z, t, p, q, sea_level_pressure, &
END IF END IF
! The grand finale: ta da! ! The grand finale: ta da!
!$OMP PARALLEL DO COLLAPSE(2) !$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
!z_half_lowest = z(i,j,1) !z_half_lowest = z(i,j,1)
@ -492,7 +496,7 @@ SUBROUTINE DFILTER2D(a, b, nx, ny, it, missing)
INTEGER :: i, j, iter INTEGER :: i, j, iter
DO iter=1,it DO iter=1,it
!$OMP PARALLEL DO COLLAPSE(2) !$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(runtime)
DO j=1,ny DO j=1,ny
DO i = 1,nx DO i = 1,nx
b(i,j) = a(i,j) b(i,j) = a(i,j)
@ -500,7 +504,7 @@ SUBROUTINE DFILTER2D(a, b, nx, ny, it, missing)
END DO END DO
!$OMP END PARALLEL DO !$OMP END PARALLEL DO
!$OMP PARALLEL DO COLLAPSE(2) !$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(runtime)
DO j=2,ny-1 DO j=2,ny-1
DO i=1,nx DO i=1,nx
IF (b(i,j-1) .EQ. missing .OR. b(i,j) .EQ. missing .OR. & IF (b(i,j-1) .EQ. missing .OR. b(i,j) .EQ. missing .OR. &
@ -513,7 +517,7 @@ SUBROUTINE DFILTER2D(a, b, nx, ny, it, missing)
END DO END DO
!$OMP END PARALLEL DO !$OMP END PARALLEL DO
!$OMP PARALLEL DO COLLAPSE(2) !$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(runtime)
DO j=1,ny DO j=1,ny
DO i=2,nx-1 DO i=2,nx-1
IF (b(i-1,j) .EQ. missing .OR. b(i,j) .EQ. missing .OR. & IF (b(i-1,j) .EQ. missing .OR. b(i,j) .EQ. missing .OR. &
@ -570,7 +574,7 @@ SUBROUTINE FILTER2D(a, b, nx, ny, it, missing)
!$OMP PARALLEL !$OMP PARALLEL
DO iter=1,it DO iter=1,it
!$OMP DO COLLAPSE(2) !$OMP DO COLLAPSE(2) SCHEDULE(runtime)
DO j=1,ny DO j=1,ny
DO i = 1,nx DO i = 1,nx
b(i,j) = a(i,j) b(i,j) = a(i,j)
@ -578,7 +582,7 @@ SUBROUTINE FILTER2D(a, b, nx, ny, it, missing)
END DO END DO
!$OMP END DO !$OMP END DO
!$OMP DO COLLAPSE(2) !$OMP DO COLLAPSE(2) SCHEDULE(runtime)
DO j=2,ny-1 DO j=2,ny-1
DO i=1,nx DO i=1,nx
IF (b(i,j-1) .EQ. missing .OR. b(i,j) .EQ. missing .OR. & IF (b(i,j-1) .EQ. missing .OR. b(i,j) .EQ. missing .OR. &
@ -591,7 +595,7 @@ SUBROUTINE FILTER2D(a, b, nx, ny, it, missing)
END DO END DO
!$OMP END DO !$OMP END DO
!$OMP DO COLLAPSE(2) !$OMP DO COLLAPSE(2) SCHEDULE(runtime)
DO j=1,ny DO j=1,ny
DO i=2,nx-1 DO i=2,nx-1
IF (b(i-1,j) .EQ. missing .OR. b(i,j) .EQ. missing .OR. & IF (b(i-1,j) .EQ. missing .OR. b(i,j) .EQ. missing .OR. &
@ -645,7 +649,7 @@ SUBROUTINE DCOMPUTERH(qv, p, t, rh, nx)
INTEGER :: i INTEGER :: i
REAL(KIND=8) :: qvs,es,pressure,temperature REAL(KIND=8) :: qvs,es,pressure,temperature
!$OMP PARALLEL DO PRIVATE(qvs, es, pressure, temperature) !$OMP PARALLEL DO PRIVATE(qvs, es, pressure, temperature) SCHEDULE(runtime)
DO i = 1,nx DO i = 1,nx
pressure = p(i) pressure = p(i)
temperature = t(i) temperature = t(i)
@ -760,7 +764,7 @@ SUBROUTINE DCOMPUTEUVMET(u, v, uvmet, longca,longcb,flong,flat, &
!$OMP PARALLEL !$OMP PARALLEL
!$OMP DO COLLAPSE(2) !$OMP DO COLLAPSE(2) SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
@ -789,7 +793,7 @@ SUBROUTINE DCOMPUTEUVMET(u, v, uvmet, longca,longcb,flong,flat, &
IF (istag .EQ. 0) THEN ! Not staggered IF (istag .EQ. 0) THEN ! Not staggered
IF (.NOT. is_msg_val) THEN ! No missing values used IF (.NOT. is_msg_val) THEN ! No missing values used
!$OMP DO COLLAPSE(2) !$OMP DO COLLAPSE(2) SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
uvmet(i,j,1) = v(i,j)*longcb(i,j) + u(i,j)*longca(i,j) uvmet(i,j,1) = v(i,j)*longcb(i,j) + u(i,j)*longca(i,j)
@ -798,7 +802,7 @@ SUBROUTINE DCOMPUTEUVMET(u, v, uvmet, longca,longcb,flong,flat, &
END DO END DO
!$OMP END DO !$OMP END DO
ELSE ! Missing values used ELSE ! Missing values used
!$OMP DO COLLAPSE(2) !$OMP DO COLLAPSE(2) SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
IF ((u(i,j) .NE. umsg .AND. v(i,j) .NE. vmsg)) THEN IF ((u(i,j) .NE. umsg .AND. v(i,j) .NE. vmsg)) THEN
@ -814,7 +818,7 @@ SUBROUTINE DCOMPUTEUVMET(u, v, uvmet, longca,longcb,flong,flat, &
END IF END IF
ELSE ! Staggered ELSE ! Staggered
IF (.NOT. is_msg_val) THEN ! No missing values used IF (.NOT. is_msg_val) THEN ! No missing values used
!$OMP DO COLLAPSE(2) !$OMP DO COLLAPSE(2) SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
! This is the more readable version. ! This is the more readable version.
@ -832,7 +836,7 @@ SUBROUTINE DCOMPUTEUVMET(u, v, uvmet, longca,longcb,flong,flat, &
END DO END DO
!$OMP END DO !$OMP END DO
ELSE ! Missing values used ELSE ! Missing values used
!$OMP DO COLLAPSE(2) !$OMP DO COLLAPSE(2) SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
IF (u(i,j) .NE. umsg .AND. v(i,j) .NE. vmsg .AND. u(i+1,j) .NE. umsg .AND. v(i,j+1) .NE. vmsg) THEN IF (u(i,j) .NE. umsg .AND. v(i,j) .NE. vmsg .AND. u(i+1,j) .NE. umsg .AND. v(i,j+1) .NE. vmsg) THEN
@ -887,7 +891,7 @@ SUBROUTINE DCOMPUTETD(td, pressure, qv_in, nx)
INTEGER :: i INTEGER :: i
!$OMP PARALLEL DO PRIVATE(i,qv,tdc) !$OMP PARALLEL DO PRIVATE(i,qv,tdc) SCHEDULE(runtime)
DO i = 1,nx DO i = 1,nx
qv = MAX(qv_in(i), 0.D0) qv = MAX(qv_in(i), 0.D0)
! vapor pressure ! vapor pressure

6
fortran/wrf_user_dbz.f90
Unescape View File

@ -80,7 +80,7 @@ SUBROUTINE CALCDBZ(prs, tmk, qvp, qra, qsn, qgr, sn0, ivarint, iliqskin, dbz, nx
!$OMP PARALLEL !$OMP PARALLEL
! Force all Q arrays to be 0.0 or greater. ! Force all Q arrays to be 0.0 or greater.
!$OMP DO COLLAPSE(3) !$OMP DO COLLAPSE(3) SCHEDULE(runtime)
DO k = 1,nz DO k = 1,nz
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
@ -104,7 +104,7 @@ SUBROUTINE CALCDBZ(prs, tmk, qvp, qra, qsn, qgr, sn0, ivarint, iliqskin, dbz, nx
! Input pressure is Pa, but we need hPa in calculations ! Input pressure is Pa, but we need hPa in calculations
IF (sn0 .EQ. 0) THEN IF (sn0 .EQ. 0) THEN
!$OMP DO COLLAPSE(3) !$OMP DO COLLAPSE(3) SCHEDULE(runtime)
DO k = 1,nz DO k = 1,nz
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
@ -125,7 +125,7 @@ SUBROUTINE CALCDBZ(prs, tmk, qvp, qra, qsn, qgr, sn0, ivarint, iliqskin, dbz, nx
!$OMP DO COLLAPSE(3) PRIVATE(i, j, k, temp_c, virtual_t, gonv, ronv, sonv, & !$OMP DO COLLAPSE(3) PRIVATE(i, j, k, temp_c, virtual_t, gonv, ronv, sonv, &
!$OMP factorb_g, factorb_s, rhoair, z_e) & !$OMP factorb_g, factorb_s, rhoair, z_e) &
!$OMP FIRSTPRIVATE(factor_r, factor_s, factor_g) !$OMP FIRSTPRIVATE(factor_r, factor_s, factor_g) SCHEDULE(runtime)
DO k = 1,nz DO k = 1,nz
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx

7
fortran/wrf_vinterp.f90
Unescape View File

@ -22,7 +22,7 @@ SUBROUTINE wrf_monotonic(out, in, lvprs, cor, idir, delta, ew, ns, nz, icorsw)
INTEGER :: i, j, k, k300 INTEGER :: i, j, k, k300
!$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i, j, k, k300) !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(i, j, k, k300) SCHEDULE(runtime)
DO j=1,ns DO j=1,ns
DO i=1,ew DO i=1,ew
k300 = -1 k300 = -1
@ -205,7 +205,8 @@ SUBROUTINE wrf_vintrp(datain, dataout, pres, tk, qvp, ght, terrain,&
!$OMP vclhsl, vctophsl, diff, isign, plhsl, zlhsl, ezlhsl, tlhsl, & !$OMP vclhsl, vctophsl, diff, isign, plhsl, zlhsl, ezlhsl, tlhsl, &
!$OMP zsurf, qvapor, psurf, psurfsm, ezsurf, plev, ezlev, zlev, & !$OMP zsurf, qvapor, psurf, psurfsm, ezsurf, plev, ezlev, zlev, &
!$OMP ptarget, dpmin, kupper, pbot, zbot, pratio, tbotextrap, & !$OMP ptarget, dpmin, kupper, pbot, zbot, pratio, tbotextrap, &
!$OMP vt, tlev, gammam, e, tlcl) REDUCTION (+:log_errcnt, interp_errcnt) !$OMP vt, tlev, gammam, e, tlcl) REDUCTION (+:log_errcnt, interp_errcnt) &
!$OMP SCHEDULE(runtime)
DO j=1,ns DO j=1,ns
DO i=1,ew DO i=1,ew
tempout(i,j) = rmsg tempout(i,j) = rmsg
@ -421,7 +422,7 @@ SUBROUTINE wrf_vintrp(datain, dataout, pres, tk, qvp, ght, terrain,&
RETURN RETURN
END IF END IF
!$OMP PARALLEL DO COLLAPSE(2) !$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(runtime)
DO j = 1,ns DO j = 1,ns
DO i = 1,ew DO i = 1,ew
dataout(i,j,nreqlvs) = tempout(i,j) dataout(i,j,nreqlvs) = tempout(i,j)

4
fortran/wrf_wind.f90
Unescape View File

@ -13,7 +13,7 @@ SUBROUTINE DCOMPUTEWSPD(wspd, u, v, nx, ny)
INTEGER i, j INTEGER i, j
!$OMP PARALLEL DO COLLAPSE(2) !$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
wspd(i,j) = SQRT(u(i,j)*u(i,j) + v(i,j)*v(i,j)) wspd(i,j) = SQRT(u(i,j)*u(i,j) + v(i,j)*v(i,j))
@ -40,7 +40,7 @@ SUBROUTINE DCOMPUTEWDIR(wdir, u, v, nx, ny)
INTEGER i, j INTEGER i, j
!$OMP PARALLEL DO COLLAPSE(2) !$OMP PARALLEL DO COLLAPSE(2) SCHEDULE(runtime)
DO j = 1,ny DO j = 1,ny
DO i = 1,nx DO i = 1,nx
wdir(i,j) = MOD(270.0 - ATAN2(v(i,j), u(i,j)) * DEG_PER_RAD, 360.) wdir(i,j) = MOD(270.0 - ATAN2(v(i,j), u(i,j)) * DEG_PER_RAD, 360.)

Write Preview
Loading…
Cancel
Save