New Velocity Potential and Stream Function Calculations #1072
+647
−4
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -10,7 +10,8 @@ | |
| !> Date | Programmer | Comments | ||
| !> -----------|---------------------|---------- | ||
| !> 2000-01-06 | Jim Tuccillo | Initial | ||
| !> 2021-06-01 | George Vandenberghe | 2D Decomposition | ||
| !> 2024-11-19 | George Vandenberghe | Add timers | ||
| !> | ||
| !> @author Jim Tuccillo IBM @date 2000-01-06 | ||
| !-------------------------------------------------------------------------------- | ||
|
|
@@ -33,10 +34,12 @@ SUBROUTINE COLLECT_LOC ( A, B ) | |
| real, dimension(ista_2l:iend_2u,jsta_2l:jend_2u), intent(in) :: a | ||
| real, dimension(im,jm), intent(out) :: b | ||
| integer ierr,n | ||
| real*8 ta,tb,tc,td,te | ||
| real, allocatable :: rbufs(:) | ||
| allocate(buff(im*jm)) | ||
| jj=( jexa(me)-jsxa(me)+1) * (iexa(me)-isxa(me)+1) | ||
| allocate( rbufs(( jexa(me)-jsxa(me)+1) * (iexa(me)-isxa(me)+1)) ) | ||
| ta=mpi_wtime() | ||
| ! | ||
| if ( num_procs <= 1 ) then | ||
| b = a | ||
|
|
@@ -81,6 +84,9 @@ SUBROUTINE COLLECT_LOC ( A, B ) | |
| deallocate(buff) | ||
| deallocate(rbufs) | ||
|
|
||
| tb=mpi_wtime() | ||
| if(me .eq. 0) print 109,' GWVX COLLECT TIME ',im,jm,tb-ta | ||
| 109 format(a,2i10,f20.10) | ||
| end | ||
| ! | ||
| !----------------------------------------------------------------------- | ||
|
|
@@ -104,6 +110,8 @@ SUBROUTINE COLLECT_ALL ( A, B ) | |
| real, dimension(im,jm), intent(out) :: b | ||
| integer ierr,n | ||
| real, allocatable :: rbufs(:) | ||
| real*8 tb,ta | ||
|
There was a problem hiding this comment. @KarinaAsmar-NOAA Clean up the debugging code in this routine. |
||
| ta=mpi_wtime() | ||
| allocate(buff(im*jm)) | ||
| jj=( jexa(me)-jsxa(me)+1) * (iexa(me)-isxa(me)+1) | ||
| allocate( rbufs(( jexa(me)-jsxa(me)+1) * (iexa(me)-isxa(me)+1)) ) | ||
|
|
@@ -146,6 +154,9 @@ SUBROUTINE COLLECT_ALL ( A, B ) | |
|
|
||
| deallocate(buff) | ||
| deallocate(rbufs) | ||
| tb=mpi_wtime() | ||
| if(me .eq. 0) print 109,' GWVX COLLECT_ALL',tb-ta | ||
| 109 format(a,f20.10) | ||
|
|
||
| end | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -39,6 +39,7 @@ | |
| !> 2023-08-24 | Y Mao | Add gtg_on option for GTG interpolation | ||
| !> 2023-09-12 | J Kenyon | Prevent spurious supercooled rain and cloud water | ||
| !> 2024-04-23 | E James | Adding smoke emissions (ebb) from RRFS | ||
| !> 2024-09-23 | K Asmar | Add velocity potential and streamfunction from wind vectors | ||
| !> | ||
| !> @author T Black W/NP2 @date 1999-09-23 | ||
| !-------------------------------------------------------------------------------------- | ||
|
|
@@ -75,7 +76,7 @@ SUBROUTINE MDL2P(iostatusD3D) | |
| IEND_2U, slrutah_on, gtg_on | ||
| use rqstfld_mod, only: IGET, LVLS, ID, IAVBLFLD, LVLSXML | ||
| use gridspec_mod, only: GRIDTYPE, MAPTYPE, DXVAL | ||
| use upp_physics, only: FPVSNEW, CALRH, CALVOR, CALSLR_ROEBBER, CALSLR_UUTAH, CALCHIPSI | ||
|
|
||
| !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| ! | ||
|
|
@@ -107,6 +108,7 @@ SUBROUTINE MDL2P(iostatusD3D) | |
| INTEGER, dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: NL1X, NL1XF | ||
| real, dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,LSM) :: TPRS, QPRS, FPRS | ||
| real, dimension(ISTA_2L:IEND_2U,JSTA_2L:JEND_2U,LSM) :: RHPRS | ||
| real, dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: CHI, PSI | ||
| ! | ||
| INTEGER K, NSMOOTH | ||
| ! | ||
|
|
@@ -228,6 +230,7 @@ SUBROUTINE MDL2P(iostatusD3D) | |
| (IGET(257) > 0) .OR. (IGET(258) > 0) .OR. & | ||
| (IGET(294) > 0) .OR. (IGET(268) > 0) .OR. & | ||
| (IGET(331) > 0) .OR. (IGET(326) > 0) .OR. & | ||
| (IGET(1021) > 0) .OR. (IGET(1022) > 0) .OR. & | ||
| ! add D3D fields | ||
| (IGET(354) > 0) .OR. (IGET(355) > 0) .OR. & | ||
| (IGET(356) > 0) .OR. (IGET(357) > 0) .OR. & | ||
|
|
@@ -1816,6 +1819,101 @@ SUBROUTINE MDL2P(iostatusD3D) | |
| ENDIF | ||
| ENDIF | ||
| ! | ||
| !*** CHIPSI | ||
| ! | ||
| IF (IGET(1021) > 0 .or. IGET(1022) > 0) THEN | ||
|
There was a problem hiding this comment. @JesseMeng-NOAA @KarinaAsmar-NOAA This new scheme will only applied in global applications. Please change as: |
||
| IF (LVLS(LP,IGET(1021)) > 0 .or. LVLS(LP,IGET(1022)) > 0) THEN | ||
WenMeng-NOAA marked this conversation as resolved.
Show resolved
Hide resolved
|
||
| CALL CALCHIPSI(USL,VSL,CHI,PSI) | ||
| ! print *,'me=',me,'EGRID1=',EGRID1(1:10,JSTA) | ||
| ! | ||
| !*** CHI | ||
| ! | ||
| IF (LVLS(LP,IGET(1021)) > 0) THEN | ||
| !$omp parallel do private(i,j) | ||
| DO J=JSTA,JEND | ||
| DO I=ISTA,IEND | ||
| GRID1(I,J) = CHI(I,J) | ||
| ENDDO | ||
| ENDDO | ||
|
|
||
| ! IF (SMFLAG .or. ioform == 'binarympiio' ) THEN | ||
|
There was a problem hiding this comment. @JesseMeng-NOAA @KarinaAsmar-NOAA The runtime reduce 7 seconds with turning off smoothc. You might remove these lines unless there is a science evaluation needed. There was a problem hiding this comment. @JesseMeng-NOAA Do we need the smoothing function or can it be removed? |
||
| ! call AllGETHERV(GRID1) | ||
| ! if (ioform == 'binarympiio') then | ||
| !! nsmooth = max(2, min(30,nint(jm/94.0))) | ||
| !! do k=1,5 | ||
| ! CALL SMOOTHC(GRID1,SDUMMY,IM,JM,0.5) | ||
| ! CALL SMOOTHC(GRID1,SDUMMY,IM,JM,-0.5) | ||
| !! enddo | ||
| ! else | ||
| ! NSMOOTH = nint(4.*(13500./dxm)) | ||
| !! endif | ||
| ! do k=1,NSMOOTH | ||
| ! CALL SMOOTH(GRID1,SDUMMY,IM,JM,0.5) | ||
| ! end do | ||
| ! endif | ||
| ! ENDIF | ||
|
|
||
| if(grib == 'grib2')then | ||
| cfld = cfld + 1 | ||
| fld_info(cfld)%ifld=IAVBLFLD(IGET(1021)) | ||
| fld_info(cfld)%lvl=LVLSXML(LP,IGET(1021)) | ||
| !$omp parallel do private(i,j,ii,jj) | ||
| do j=1,jend-jsta+1 | ||
| jj = jsta+j-1 | ||
| do i=1,iend-ista+1 | ||
| ii=ista+i-1 | ||
| datapd(i,j,cfld) = GRID1(ii,jj) | ||
| enddo | ||
| enddo | ||
| endif | ||
| ENDIF !CHI | ||
| ! | ||
| !*** PSI | ||
| ! | ||
| IF (LVLS(LP,IGET(1022)) > 0) THEN | ||
| !$omp parallel do private(i,j) | ||
| DO J=JSTA,JEND | ||
| DO I=ISTA,IEND | ||
| GRID1(I,J) = PSI(I,J) | ||
| ENDDO | ||
| ENDDO | ||
|
|
||
| ! IF (SMFLAG .or. ioform == 'binarympiio' ) THEN | ||
| ! call AllGETHERV(GRID1) | ||
| ! if (ioform == 'binarympiio') then | ||
| !! nsmooth = max(2, min(30,nint(jm/94.0))) | ||
| !! do k=1,5 | ||
| ! CALL SMOOTHC(GRID1,SDUMMY,IM,JM,0.5) | ||
| ! CALL SMOOTHC(GRID1,SDUMMY,IM,JM,-0.5) | ||
| !! enddo | ||
| ! else | ||
| ! NSMOOTH = nint(4.*(13500./dxm)) | ||
| !! endif | ||
| ! do k=1,NSMOOTH | ||
| ! CALL SMOOTH(GRID1,SDUMMY,IM,JM,0.5) | ||
| ! end do | ||
| ! endif | ||
| ! ENDIF | ||
|
|
||
| if(grib == 'grib2')then | ||
| cfld = cfld + 1 | ||
| fld_info(cfld)%ifld=IAVBLFLD(IGET(1022)) | ||
| fld_info(cfld)%lvl=LVLSXML(LP,IGET(1022)) | ||
| !$omp parallel do private(i,j,ii,jj) | ||
| do j=1,jend-jsta+1 | ||
| jj = jsta+j-1 | ||
| do i=1,iend-ista+1 | ||
| ii=ista+i-1 | ||
| datapd(i,j,cfld) = GRID1(ii,jj) | ||
| enddo | ||
| enddo | ||
| endif | ||
| ENDIF !PSI | ||
|
|
||
| ENDIF !LVLS(CHIPSI) | ||
| ENDIF !CHIPSI | ||
| ! | ||
| ! | ||
| ! GEOSTROPHIC STREAMFUNCTION. | ||
| IF (IGET(086) > 0) THEN | ||
| IF (LVLS(LP,IGET(086)) > 0) THEN | ||
|
|
||
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
@KarinaAsmar-NOAA Clean up the debugging code.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
@GeorgeVandenberghe-NOAA Would you please clean up the debugging part of COLLECT_LOC.f? Let me know when done and I'll push it to this branch.