Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

2D Decomposition #339

Merged
merged 97 commits into from
Jun 8, 2022
Merged

2D Decomposition #339

Show file tree
Hide file tree
Changes from 41 commits
Commits
Show all changes
97 commits
Select commit Hold shift + click to select a range
220adbf
Changes to support 2D Decomposition shape changes. Full I dimension …
GeorgeVandenberghe-NOAA Apr 1, 2021
ce6c989
test of commit only added one comment to PROCESS.f
GeorgeVandenberghe-NOAA Apr 1, 2021
42e2896
comment test 2
GeorgeVandenberghe-NOAA Apr 1, 2021
5785961
Added more routines to 2D decomposition
GeorgeVandenberghe-NOAA Apr 27, 2021
9679366
Changed isx and iex to ISTA and IEND in listed routines. ISTA had p…
GeorgeVandenberghe-NOAA Apr 30, 2021
01e2010
Merge remote-tracking branch 'upstream/develop' into develop
May 3, 2021
90bbc57
test commit of new base into clone
May 3, 2021
e03f8ac
repair of a bunch of changed routines somehow corrupted by a merge 5/…
May 4, 2021
545245d
Merge remote-tracking branch 'upstream/develop' into develop
GeorgeVandenberghe-NOAA May 25, 2021
6d306b4
fixed 5/25 problem
GeorgeVandenberghe-NOAA May 25, 2021
25bf506
added ctlblk change to support ista and iend partial I dimensons
GeorgeVandenberghe-NOAA May 25, 2021
37bc963
added para_range2 to PARA_RANGE.f to support 2D decomposition
GeorgeVandenberghe-NOAA May 25, 2021
b488901
Modified MPI_FIRST.f to support a 2D decomposition but the actual num…
GeorgeVandenberghe-NOAA May 27, 2021
c6fc2d0
Merge remote-tracking branch 'upstream/develop' into develop
GeorgeVandenberghe-NOAA May 28, 2021
d7c4ec8
Added support for halo settings of 2D boundaries i.e ista_2l to match…
GeorgeVandenberghe-NOAA Jun 1, 2021
a508840
Added definitions for ista_2u, and ista_2u in MPI_FIRST.f
GeorgeVandenberghe-NOAA Jun 2, 2021
54f4e92
Reshaped arrays in MDL2FLD.f to support 2D decomposition. Modified …
GeorgeVandenberghe-NOAA Jun 3, 2021
34673c1
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Jun 22, 2021
c3987ee
Remove TIMEF.f.
WenMeng-NOAA Jun 22, 2021
9f6ce39
20210702 JesseMeng modify MPI_FIRST.f MDLFLD.f for 2D decomposition
Jul 3, 2021
9d9ef6a
20210706 BoCui modify INITPOST_GFS_NETCDF_PARA.f
BoCui-NOAA Jul 6, 2021
2ea27da
20210707 JesseMeng modified grib2_module.f for 2d decomposition
Jul 7, 2021
ad0a0f8
test version INITPOST_GFS_NETCDF_PARA.f
BoCui-NOAA Jul 8, 2021
c07c1ce
test version INITPOST_GFS_NETCDF_PARA.f and MPI_FIRST.f
BoCui-NOAA Jul 12, 2021
9c0326d
20210713 BoCui test INITPOST_GFS_NETCDF_PARA.f, MPI_FIRST.f and ALLOC…
BoCui-NOAA Jul 13, 2021
7406405
20210713 BoCui test INITPOST_GFS_NETCDF_PARA.f, MPI_FIRST.f and ALLOC…
BoCui-NOAA Jul 14, 2021
f62b62f
20210719 BoCui Modified CLDRAD.f for 2d decomposition
BoCui-NOAA Jul 20, 2021
820a6b3
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Aug 13, 2021
97c30eb
20210816 Jesse Meng commit George's EXCH update for 1 layer 2D halos …
Aug 16, 2021
47ca889
20210816 Jesse Meng remove ifcore in EXCH
Aug 16, 2021
6eac910
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp a…
WenMeng-NOAA Sep 2, 2021
2bbcdb4
20210903 Bo Cui update ALLOCATE_ALL.f after new merge from 'upstream/…
BoCui-NOAA Sep 3, 2021
61e2056
20210903 Bo Cui Added new routines to 2D decomposition
BoCui-NOAA Sep 3, 2021
ea445e7
20210903 Jesse Meng fixed the ieql allocation bug in ALLOCATE_ALL.f
Sep 3, 2021
03a793b
20210904 Bo Cui fixed CLDRAD.f
BoCui-NOAA Sep 4, 2021
70e502b
20210913 Jesse Meng commit progress of 2D decomposition
Sep 13, 2021
b502992
20210917 Bo Cui add new routines to 2D decomposition
BoCui-NOAA Sep 17, 2021
09d5b92
20210917 Jesse Meng remove 4 legacy files
Sep 17, 2021
50f11eb
20210917 Jesse Meng remove legacy code SLP_NMM EXCH2
Sep 17, 2021
fa8b9ce
20210917 Jesse Meng remove legacy code INITPOST_GFS_SIGIO.f INITPOST_…
Sep 17, 2021
3f464b2
20210917 Jesse Meng add INITPOST_GFS_NEMS.f back to avoid compiling e…
Sep 17, 2021
ad88ca0
20210930 Jesse Meng add George's itag/numx entry and progress on 2D d…
Sep 30, 2021
069a4f9
20211015 Jesse Meng progress on 2D DECOMPOSITION
Oct 15, 2021
da41585
20211017 Bo Cui add new subroutines to UPP 2D decomposition
BoCui-NOAA Oct 17, 2021
40ed93d
20211026 Jesse Meng commit progress in 2D DECOMPOSITION
Oct 26, 2021
2084479
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Oct 26, 2021
9306634
20211026 Jesse Meng fix INITPOST_GFS_NETCDF_PARA.f for 2D DECOMPOSITION
Oct 26, 2021
6308e3c
20211026 Jesse Meng update SURFCE.f for 2D DECOMPOSITION
Oct 26, 2021
05c9da4
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Oct 28, 2021
0d94ede
Merge branch 'post_2d_decomp' of github.com:WenMeng-NOAA/UPP into pos…
WenMeng-NOAA Oct 28, 2021
b0c9102
20211103 Jesse Meng commit progress of 2D DECOMPOSITION
Nov 3, 2021
1e5577c
20211106 Bo Cui commit progress of 2D decomposition
BoCui-NOAA Nov 6, 2021
61411e9
20211109 Jesse Meng updates for 2D DECOMPOSITION
Nov 9, 2021
8d88e6c
20211110 Jesse Meng updates in 2D DECOMPOSITION
Nov 10, 2021
db532a1
20211112 Jesse Meng updates for 2D DECOMPOSITION
Nov 12, 2021
af345c2
20211115 Jesse Meng updates for 2D DECOMPOSITION
Nov 15, 2021
045f797
20211119 Jesse Meng updates for 2D DECOMPOSITION
Nov 19, 2021
d518f81
20211201 Jesse Meng move CALVOR to UPP_PHYSICS module; implement full…
Dec 2, 2021
74d5f84
20211202 Jesse Meng minor update of MPI_FIRST using mpi_allgatherv
Dec 2, 2021
8c7bab6
20211203 Jesse Meng implement fullpole in MDL2THANDPV and CALDIV
Dec 4, 2021
76d4a5d
20211207 Jesse Meng update MISCLN.f SURFCE.f
Dec 7, 2021
278fa2a
20211208 Jesse Meng add parm/hafs_nosat files
Dec 8, 2021
d010934
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Dec 13, 2021
9d4c3fa
20211213 Bo Cui updates for 2D decomposition
BoCui-NOAA Dec 13, 2021
355eb3f
20211213 Jesse Meng update the merged 'upstream/develop' and 'post_2d…
Dec 14, 2021
49d4680
20211215 Jesse Meng use i=0:im+1 for GFS in MPI_FIRST and EXCH
Dec 15, 2021
08f7f41
20211216 Jesse Meng minor update UPP_PHYSICS for i=0:im+1 expansion
Dec 16, 2021
b7d5d87
20220104 Jesse Meng add George's minor fix in EXHC.f
Jan 4, 2022
25777b1
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Jan 5, 2022
e5d3abb
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Jan 8, 2022
5376c98
20220118 Jesse Meng commit George's cleaned up code.
JesseMeng-NOAA Jan 18, 2022
d7cfc13
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Jan 19, 2022
5aab68f
20220203 Jesse Meng - update MAPSSLP.f to be consistent with develop …
JesseMeng-NOAA Feb 3, 2022
2eec2ff
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Feb 3, 2022
dbf95e0
Merge branch 'post_2d_decomp' of github.com:WenMeng-NOAA/UPP into pos…
WenMeng-NOAA Feb 3, 2022
1551b49
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Feb 15, 2022
6b735fc
20220222 Jesse Meng add checkcoords flag in EXCH.f to move around Geo…
Feb 22, 2022
a4bd92d
20220302 Jesse Meng Restrict computation from undefined grids
Mar 2, 2022
c559c31
20220304 Bo Cui Add a reset of numx=1 if remainder of num_procs/numx …
BoCui-NOAA Mar 4, 2022
97c02a5
20220310 Jesse Meng Add a reset of numx=1 if(numx>num_procs/2)
Mar 11, 2022
8399416
20220322 Jesse Meng mpi_allgatherv change communicator to MPI_COMM_COMP
Mar 22, 2022
36bd675
20220328 Jesse Meng bug fix for passing 2d subarrays between subroutines
Mar 28, 2022
8522567
20220328 Jesse Meng minor fix for CLDRAD call BOUND variable array size
Mar 29, 2022
b78a3a3
20220330 Jesse Meng fix cloud cover variabes full field collection in…
Mar 30, 2022
d3d5954
20220401 Jesse Meng minor fix for CALMCVG.f and update CALUPDHEL.f wi…
Apr 1, 2022
5186eb2
20220414 BoCui sync and merge UPP/develop into post_2d_decomp (#7)
BoCui-NOAA Apr 22, 2022
08253d6
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA Apr 24, 2022
706da28
20220502 Bo Cui code cleanup
BoCui-NOAA May 2, 2022
b1c327a
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA May 11, 2022
a88d252
20220512 Jesse Meng minor fix for INITPOST_GFS_NEMS_MPIIO.f calling EXCH
May 12, 2022
d9fb062
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA May 23, 2022
ee7b243
Merge remote-tracking branch 'upstream/develop' into post_2d_decomp
WenMeng-NOAA May 24, 2022
5f72e89
20220525 Jesse Meng minor fix to 2d_decomp syntax
May 25, 2022
b18aaab
Update VERSION to 11.0.0
WenMeng-NOAA Jun 7, 2022
fb312cd
20220607 Jesse Meng add variable declaration block in PARA_RANGE.f
Jun 7, 2022
75905e9
20220608 Jesse Meng remove blank spaces in sorc/ncep_post.fd/AllGETHE…
Jun 8, 2022
2b205eb
Add 2D decomp overview documentation (#6)
fossell Jun 8, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1,006 changes: 503 additions & 503 deletions sorc/ncep_post.fd/ALLOCATE_ALL.f
View file
Open in desktop

Large diffs are not rendered by default.

59 changes: 30 additions & 29 deletions sorc/ncep_post.fd/AVIATION.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@
!! PRGRMMR: Binbin Zhou /NCEP/EMC DATE: 2005-08-16
!! 19-10-30 Bo CUI - REMOVE "GOTO" STATEMENT
!! 21-04-01 Jesse Meng - computation on defined points only
!! 21-09-02 Bo Cui - Decompose UPP in X direction
!!
!! ABSTRACT:
!! This program computes the low level wind shear(LLWS) over 0-2000 feet (0-609.5m)
Expand Down Expand Up @@ -84,7 +85,7 @@ SUBROUTINE CALLLWS(U,V,H,LLWS)
!
USE vrbls2d, only: fis, u10, v10
use params_mod, only: gi
use ctlblk_mod, only: jsta, jend, im, jm, lsm, spval
use ctlblk_mod, only: jsta, jend, im, jm, lsm, spval, ista, iend
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
Expand All @@ -101,7 +102,7 @@ SUBROUTINE CALLLWS(U,V,H,LLWS)
!

DO 100 J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND

Z1 = 10.0 + FIS(I,J)*GI !Height of 10m levels geographic height (from sea level)

Expand Down Expand Up @@ -196,20 +197,20 @@ SUBROUTINE CALICING (T1,RH,OMGA, ICING)
! MACHINE : BLUE AT NCEP
!$$$
!
use ctlblk_mod, only: jsta, jend, im, spval
use ctlblk_mod, only: jsta, jend, im, spval, ista, iend
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
! DECLARE VARIABLES.
!
REAL, DIMENSION(IM,jsta:jend), INTENT(IN) :: T1,RH,OMGA
REAL, DIMENSION(IM,jsta:jend), INTENT(INOUT) :: ICING
REAL, DIMENSION(ista:iend,jsta:jend), INTENT(IN) :: T1,RH,OMGA
REAL, DIMENSION(ista:iend,jsta:jend), INTENT(INOUT) :: ICING
integer I,J
!***************************************************************
!
!
DO J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND
IF(OMGA(I,J)<SPVAL.AND.T1(I,J)<SPVAL.AND.RH(I,J)<SPVAL) THEN
IF(OMGA(I,J) < 0.0 .AND. &
(T1(I,J) <= 273.0 .AND. T1(I,J) >= 251.0) &
Expand Down Expand Up @@ -277,7 +278,7 @@ SUBROUTINE CALCAT(U,V,H,U_OLD,V_OLD,H_OLD,CAT)
!$$$
use masks, only: dx, dy
use ctlblk_mod, only: spval, jsta_2l, jend_2u, jsta_m, jend_m, &
im, jm
im, jm, ista_2l, iend_2u, ista_m, iend_m, ista, iend
use gridspec_mod, only: gridtype
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Expand All @@ -286,10 +287,10 @@ SUBROUTINE CALCAT(U,V,H,U_OLD,V_OLD,H_OLD,CAT)
!
! DECLARE VARIABLES.
!
REAL,DIMENSION(IM,jsta_2l:jend_2u),INTENT(IN) :: U,V,H, &
REAL,DIMENSION(ista_2l:iend_2u,jsta_2l:jend_2u),INTENT(IN) :: U,V,H, &
U_OLD,V_OLD,H_OLD
! INTEGER,INTENT(IN) :: L
REAL,DIMENSION(IM,jsta_2l:jend_2u),INTENT(INOUT) :: CAT
REAL,DIMENSION(ista_2l:iend_2u,jsta_2l:jend_2u),INTENT(INOUT) :: CAT

REAL DSH, DST, DEF, CVG, VWS, TRBINDX
INTEGER IHE(JM),IHW(JM)
Expand All @@ -305,22 +306,22 @@ SUBROUTINE CALCAT(U,V,H,U_OLD,V_OLD,H_OLD,CAT)
IF(GRIDTYPE == 'A')THEN
IHW(J)=-1
IHE(J)=1
ISTART=2
ISTOP=IM-1
ISTART=ISTA_M
ISTOP=IEND_M
JSTART=JSTA_M
JSTOP=JEND_M
ELSE IF(GRIDTYPE=='E')THEN
IHW(J)=-MOD(J,2)
IHE(J)=IHW(J)+1
ISTART=2
ISTOP=IM-1
ISTART=ISTA_M
ISTOP=IEND_M
JSTART=JSTA_M
JSTOP=JEND_M
ELSE IF(GRIDTYPE=='B')THEN
IHW(J)=-1
IHE(J)=0
ISTART=2
ISTOP=IM-1
ISTART=ISTA_M
ISTOP=IEND_M
JSTART=JSTA_M
JSTOP=JEND_M
ELSE
Expand All @@ -329,12 +330,12 @@ SUBROUTINE CALCAT(U,V,H,U_OLD,V_OLD,H_OLD,CAT)
END IF
ENDDO

call exch_f(U)
call exch_f(V)
call exch_f(U_OLD)
call exch_f(V_OLD)
call exch_f(H)
call exch_f(H_OLD)
call exch(U)
call exch(V)
call exch(U_OLD)
call exch(V_OLD)
call exch(H)
call exch(H_OLD)

DO 100 J=JSTART,JSTOP
DO I=ISTART,ISTOP
Expand Down Expand Up @@ -531,20 +532,20 @@ SUBROUTINE CALCEILING (CLDZ,TCLD,CEILING)

USE vrbls2d, only: fis
use params_mod, only: small, gi
use ctlblk_mod, only: jsta, jend, spval, im, modelname
use ctlblk_mod, only: jsta, jend, spval, im, modelname, ista, iend
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
! DECLARE VARIABLES.
!
REAL, DIMENSION(IM,jsta:jend), INTENT(IN) :: CLDZ, TCLD
REAL, DIMENSION(IM,jsta:jend), INTENT(INOUT) :: CEILING
REAL, DIMENSION(ista:iend,jsta:jend), INTENT(IN) :: CLDZ, TCLD
REAL, DIMENSION(ista:iend,jsta:jend), INTENT(INOUT) :: CEILING
integer I,J
!***************************************************************
!
!
DO J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND
IF(ABS(TCLD(I,J)-SPVAL) <= SMALL) THEN
CEILING(I,J)=SPVAL
ELSE IF(TCLD(I,J) >= 50.) THEN
Expand Down Expand Up @@ -605,22 +606,22 @@ SUBROUTINE CALFLTCND (CEILING,FLTCND)
!$$$
!
use vrbls2d, only: vis
use ctlblk_mod, only: jsta, jend, im, spval
use ctlblk_mod, only: jsta, jend, im, spval, ista, iend
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
! DECLARE VARIABLES.
!
REAL, DIMENSION(IM,jsta:jend), INTENT(IN) :: CEILING
REAL, DIMENSION(IM,jsta:jend), INTENT(INOUT) :: FLTCND
REAL, DIMENSION(ista:iend,jsta:jend), INTENT(IN) :: CEILING
REAL, DIMENSION(ista:iend,jsta:jend), INTENT(INOUT) :: FLTCND
REAL CEIL,VISI
integer I,J
!
!***************************************************************
!
!
DO J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND

IF(CEILING(I,J)<spval.and.VIS(I,J)<spval)THEN
CEIL = CEILING(I,J) * 3.2808 !from m -> feet
Expand Down
11 changes: 6 additions & 5 deletions sorc/ncep_post.fd/AllGETHERV_GSD.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,8 +9,9 @@ SUBROUTINE AllGETHERV(GRID1)
!
! PROGRAM HISTORY LOG:
!
! 21-09-02 Bo Cui - Decompose UPP in X direction

use ctlblk_mod, only : im,jm,num_procs,me,jsta,jend,mpi_comm_comp
use ctlblk_mod, only : im,jm,num_procs,me,jsta,jend,ista,iend,mpi_comm_comp

implicit none

Expand All @@ -22,11 +23,11 @@ SUBROUTINE AllGETHERV(GRID1)

REAL GRID1(IM,JM)
REAL ibufrecv(IM*JM)
REAL ibufsend(im*(jend-jsta+1))
REAL ibufsend((iend-ista+1)*(jend-jsta+1))
integer SENDCOUNT,RECVCOUNTS(num_procs),DISPLS(num_procs)
!
! write(*,*) 'check mpi', im,jm,num_procs,me,jsta,jend
SENDCOUNT=im*(jend-jsta+1)
SENDCOUNT=(iend-ista+1)*(jend-jsta+1)
call MPI_ALLGATHER(SENDCOUNT, 1, MPI_INTEGER, RECVCOUNTS,1 , &
MPI_INTEGER, mpi_comm_comp, ierr)
DISPLS(1)=0
Expand All @@ -40,7 +41,7 @@ SUBROUTINE AllGETHERV(GRID1)
ij=0
ibufsend=0.0
do j=jsta,jend
do i=1,IM
do i=ista,iend
ij=ij+1
ibufsend(ij)=GRID1(i,j)
enddo
Expand All @@ -54,7 +55,7 @@ SUBROUTINE AllGETHERV(GRID1)

ij=0
do j=1,JM
do i=1,IM
do i=1,IM
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

remove extra spaces?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Done

ij=ij+1
GRID1(i,j)=ibufrecv(ij)
enddo
Expand Down
57 changes: 29 additions & 28 deletions sorc/ncep_post.fd/BNDLYR.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,7 @@
!! 02-01-15 MIKE BALDWIN - WRF VERSION
!! 20-11-10 JESSE MENG - USE UPP_PHYSICS MODULE
!! 21-08-20 Wen Meng - Retrict computation fro undefined points.
!! 21-09-02 Bo Cui - Decompose UPP in X directio
!!
!! USAGE: CALL BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND,
!! WBND,OMGBND,PWTBND,QCNVBND)
Expand Down Expand Up @@ -73,7 +74,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
use masks, only: lmh
use params_mod, only: d00, gi, pq0, a2, a3, a4
use ctlblk_mod, only: jsta_2l, jend_2u, lm, jsta, jend, modelname, &
jsta_m, jend_m, im, nbnd, spval
jsta_m, jend_m, im, nbnd, spval, ista_2l, iend_2u, ista_m, iend_m, ista, iend
use physcons_post, only: con_rd, con_rv, con_eps, con_epsm1
use gridspec_mod, only: gridtype
use upp_physics, only: FPVSNEW
Expand All @@ -83,12 +84,12 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
! DECLARE VARIABLES.
!
real,PARAMETER :: DPBND=30.E2
integer, dimension(IM,jsta:jend,NBND),intent(inout) :: LVLBND
real, dimension(IM,jsta:jend,NBND),intent(inout) :: PBND,TBND, &
integer, dimension(ista:iend,jsta:jend,NBND),intent(inout) :: LVLBND
real, dimension(ista:iend,jsta:jend,NBND),intent(inout) :: PBND,TBND, &
QBND,RHBND,UBND,VBND,WBND,OMGBND,PWTBND,QCNVBND

REAL Q1D(IM,JSTA_2L:JEND_2U),V1D(IM,JSTA_2L:JEND_2U), &
U1D(IM,JSTA_2L:JEND_2U),QCNV1D(IM,JSTA_2L:JEND_2U)
REAL Q1D(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),V1D(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U), &
U1D(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U),QCNV1D(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U)
!
REAL, ALLOCATABLE :: PBINT(:,:,:),QSBND(:,:,:)
REAL, ALLOCATABLE :: PSUM(:,:,:), QCNVG(:,:,:)
Expand All @@ -101,27 +102,27 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
!*****************************************************************************
! START BNDLYR HERE
!
ALLOCATE (PBINT(IM,JSTA_2L:JEND_2U,NBND+1))
ALLOCATE (QSBND(IM,JSTA_2L:JEND_2U,NBND))
ALLOCATE (PSUM(IM,JSTA_2L:JEND_2U,NBND))
ALLOCATE (QCNVG(IM,JSTA_2L:JEND_2U,LM))
ALLOCATE (PVSUM(IM,JSTA_2L:JEND_2U,NBND))
ALLOCATE (NSUM(IM,JSTA_2L:JEND_2U,NBND))
ALLOCATE (PBINT(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,NBND+1))
ALLOCATE (QSBND(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,NBND))
ALLOCATE (PSUM(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,NBND))
ALLOCATE (QCNVG(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,LM))
ALLOCATE (PVSUM(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,NBND))
ALLOCATE (NSUM(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,NBND))
!
! LOOP OVER HORIZONTAL GRID. AT EACH MASS POINT COMPUTE
! PRESSURE AT THE INTERFACE OF EACH BOUNDARY LAYER.
!
!$omp parallel do private(i,j)
DO J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND
PBINT(I,J,1) = PINT(I,J,NINT(LMH(I,J))+1)
ENDDO
ENDDO
!
DO LBND=2,NBND+1
!$omp parallel do private(i,j)
DO J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND
PBINT(I,J,LBND) = PBINT(I,J,LBND-1) - DPBND
ENDDO
ENDDO
Expand All @@ -131,7 +132,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
DO L=1,LM
!$omp parallel do private(i,j)
DO J=JSTA_2L,JEND_2U
DO I=1,IM
DO I=ISTA_2L,IEND_2U
Q1D(I,J) = Q(I,J,L)
U1D(I,J) = UH(I,J,L)
V1D(I,J) = VH(I,J,L)
Expand All @@ -140,7 +141,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
CALL CALMCVG(Q1D,U1D,V1D,QCNV1D)
!$omp parallel do private(i,j)
DO J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND
QCNVG(I,J,L)=QCNV1D(I,J)
ENDDO
ENDDO
Expand All @@ -156,7 +157,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
DO LBND=1,NBND
!$omp parallel do private(i,j)
DO J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND
PBND(I,J,LBND) = D00
TBND(I,J,LBND) = D00
QBND(I,J,LBND) = D00
Expand All @@ -179,7 +180,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
DO L=1,LM
!$omp parallel do private(i,j,dp,pm,es,qsat)
DO J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND
!
PM = PMID(I,J,L)
IF(PM<SPVAL)THEN
Expand Down Expand Up @@ -227,12 +228,12 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &


IF(gridtype=='E')THEN
CALL EXCH(PINT(1:IM,JSTA_2L:JEND_2U,1))
CALL EXCH(PINT(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,1))
DO L=1,LM
CALL EXCH(PINT(1:IM,JSTA_2L:JEND_2U,L+1))
CALL EXCH(PINT(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,L+1))
!$omp parallel do private(i,j,ie,iw,dp,pv1,pv2,pmv)
DO J=JSTA_M,JEND_M
DO I=2,IM-1
DO I=ISTA_M,IEND_M
IE = I+MOD(J,2)
IW = I+MOD(J,2)-1
PV1 = 0.25*(PINT(IW,J,L) + PINT(IE,J,L) &
Expand All @@ -252,12 +253,12 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
ENDDO
ENDDO
ELSE IF (gridtype=='B')THEN
CALL EXCH(PINT(1:IM,JSTA_2L:JEND_2U,1))
CALL EXCH(PINT(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,1))
DO L=1,LM
CALL EXCH(PINT(1:IM,JSTA_2L:JEND_2U,L+1))
CALL EXCH(PINT(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,L+1))
!$omp parallel do private(i,j,ie,iw,dp,pv1,pv2,pmv)
DO J=JSTA_M,JEND_M
DO I=2,IM-1
DO I=ISTA_M,IEND_M
IE = I+1
IW = I
PV1 = 0.25*(PINT(IW,J,L) + PINT(IE,J,L) &
Expand All @@ -284,7 +285,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
!$omp parallel do private(i,j,lbnd,rpsum,rpvsum)
DO LBND=1,NBND
DO J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND
IF(PSUM(I,J,LBND)/=0..AND.TBND(I,J,LBND)<SPVAL)THEN
RPSUM = 1./PSUM(I,J,LBND)
LVLBND(I,J,LBND)= LVLBND(I,J,LBND)/NSUM(I,J,LBND)
Expand All @@ -306,7 +307,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &

IF(gridtype=='E' .or. gridtype=='B')THEN
DO J=JSTA_M,JEND_M
DO I=2,IM-1
DO I=ISTA_M,IEND_M
IF(PVSUM(I,J,LBND)/=0.)THEN
RPVSUM = 1./PVSUM(I,J,LBND)
UBND(I,J,LBND) = UBND(I,J,LBND)*RPVSUM
Expand All @@ -325,7 +326,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
!$omp& qsat,pmv,delpv,lv)
DO LBND=1,NBND
DO J=JSTA,JEND
DO I=1,IM
DO I=ISTA,IEND
IF(PSUM(I,J,LBND)==0..AND.PBND(I,J,LBND)<SPVAL)THEN
L = LM
PMIN = 9999999.
Expand Down Expand Up @@ -381,7 +382,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
!
IF(gridtype == 'E')THEN
DO J=JSTA_M,JEND_M
DO I=2,IM-1
DO I=ISTA_M,IEND_M
IF(PVSUM(I,J,LBND)==0.)THEN
LV = LM
PMINV = 9999999.
Expand Down Expand Up @@ -411,7 +412,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &

ELSE IF(gridtype=='B')THEN
DO J=JSTA_M,JEND_M
DO I=2,IM-1
DO I=ISTA_M,IEND_M
IF(PVSUM(I,J,LBND)==0.)THEN
LV=LM
PMINV=9999999.
Expand Down
Loading