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

MISCLN.f updated to resolve issues in generating SPC fields using RRF… #682

Merged
merged 6 commits into from
Apr 7, 2023
Merged

MISCLN.f updated to resolve issues in generating SPC fields using RRF… #682

Changes from 4 commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
9b911b2
MISCLN.f updated to resolve issues in generating SPC fields using RRF…
Apr 1, 2023
d57390b
Update MISCLN.f
EdwardColon-NOAA Apr 3, 2023
56521de
Update MISCLN.f
EdwardColon-NOAA Apr 3, 2023
bf5baf4
Merge remote-tracking branch 'upstream/develop' into feature/pre-HWT
Apr 3, 2023
52a258d
Update MISCLN.f
EdwardColon-NOAA Apr 5, 2023
9cf4858
Update MISCLN.f
EdwardColon-NOAA Apr 5, 2023
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
56 changes: 33 additions & 23 deletions sorc/ncep_post.fd/MISCLN.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,7 @@
!! 22-09-22 L Zhang - Li(Kate) Zhang - Remove Dust=> AERFD
!! 22-10-06 W Meng - Generate SPC fields with RRFS input
!! 23-01-24 Sam Trahan - when IFI is enabled, calculate and store CAPE & CIN. Add allocate_cape_arrays
!!
!! 23-04-03 E Colon - Added additional array assignments to resolve SPC fields crashes for RRFS input
!! USAGE: CALL MISCLN
!! INPUT ARGUMENT LIST:
!!
Expand Down Expand Up @@ -146,7 +146,7 @@ SUBROUTINE MISCLN
UBND, VBND, RHBND, &
WBND, T7D, Q7D, &
U7D, V6D, P7D, &
ICINGFD,GTGFD,CATFD,MWTFD
ICINGFD,GTGFD,CATFD,MWTFD,MIDCAL
WenMeng-NOAA marked this conversation as resolved.
Show resolved Hide resolved

real, dimension(:,:),allocatable :: QM8510, RH4710, RH8498, &
RH4796, RH1847, UST, VST, &
Expand All @@ -159,10 +159,11 @@ SUBROUTINE MISCLN
real, dimension(:,:), allocatable :: USHR1, VSHR1, USHR6, VSHR6, &
MAXWP, MAXWZ, MAXWU, MAXWV, &
MAXWT
INTEGER,dimension(:,:),allocatable :: LLOW, LUPP
INTEGER,dimension(:,:),allocatable :: LLOW,LUPP,LLOW_ZINT,IEQL_ZINT, &
Z_MIDCAL
REAL, dimension(:,:),allocatable :: CANGLE,ESHR,UVECT,VVECT,&
EFFUST,EFFVST,FSHR,HTSFC,&
ESRH
ESRH,Z_TEMP
!
integer I,J,ii,jj,L,ITYPE,ISVALUE,LBND,ILVL,IFD,ITYPEFDLVL(NFD), &
iget1, iget2, iget3, LLMH,imax,jmax,lmax
Expand All @@ -176,7 +177,7 @@ SUBROUTINE MISCLN
REAL, allocatable :: HTFDCTL(:)
integer, allocatable :: ITYPEFDLVLCTL(:)
integer IE,IW,JN,JS,IVE(JM),IVW(JM),JVN,JVS
integer ISTART,ISTOP,JSTART,JSTOP,MIDCAL
integer ISTART,ISTOP,JSTART,JSTOP
real dummy(ista:iend,jsta:jend)
integer idummy(ista:iend,jsta:jend)
! NEW VARIABLES USED FOR EFFECTIVE LAYER
Expand Down Expand Up @@ -1205,7 +1206,7 @@ SUBROUTINE MISCLN
! print *, "GTG 467 levels=",pset%param(N)%level
allocate(GTGFD(ISTA:IEND,JSTA:JEND,NFDCTL))
call FDLVL_MASS(ITYPEFDLVLCTL,NFDCTL,HTFDCTL,GTG,GTGFD)
! print *, "GTG 467 Done GTGFD=",me,GTGFD(IM/2,jend,1:NFDCTL)
! print *, "GTG 467 Done GTGFD=",me,GTGFD(IM/2,jend,1:NFDCTL)

WenMeng-NOAA marked this conversation as resolved.
Show resolved Hide resolved
! Regional GTG has a legend of special defination
! 0 m holds the max value of the whole vertical column
Expand Down Expand Up @@ -3724,7 +3725,10 @@ SUBROUTINE MISCLN
HELI(ista_2l:iend_2u,jsta_2l:jend_2u,2))
allocate(LLOW(ista_2l:iend_2u,jsta_2l:jend_2u),LUPP(ista_2l:iend_2u,jsta_2l:jend_2u), &
CANGLE(ista_2l:iend_2u,jsta_2l:jend_2u))

allocate(LLOW_ZINT(ista_2l:iend_2u,jsta_2l:jend_2u), &
IEQL_ZINT(ista_2l:iend_2u,jsta_2l:jend_2u),Z_TEMP(ista_2l:iend_2u,jsta_2l:jend_2u))
allocate(MIDCAL(ista_2l:iend_2u,jsta_2l:jend_2u,1:LM))
allocate(Z_MIDCAL(ista_2l:iend_2u,jsta_2l:jend_2u))
WenMeng-NOAA marked this conversation as resolved.
Show resolved Hide resolved
iget1 = IGET(953)
iget2 = -1
iget3 = -1
Expand Down Expand Up @@ -3768,7 +3772,6 @@ SUBROUTINE MISCLN
DO J=JSTA,JEND
DO I=ISTA,IEND
IREC = IREC + 1
! WRITE(IUNIT,'(1x,I6,2x,I6,2x,I6,2x,I6)')I,J,LLOW(I,J),LUPP(I,J)
WRITE(IUNIT,'(1x,I6,2x,I6,2(2x,I6,2x,F12.3))') I, J, &
LLOW(I,J),PMID(I,J,LLOW(I,J)), &
LUPP(I,J),PMID(I,J,LUPP(I,J))
Expand All @@ -3778,15 +3781,13 @@ SUBROUTINE MISCLN
ENDIF


! CALL CALHEL(DEPTH,UST,VST,HELI,USHR1,VSHR1,USHR6,VSHR6)
CALL CALHEL2(LLOW,LUPP,DEPTH,UST,VST,HELI,CANGLE)
!
IF (iget2 > 0) then
!$omp parallel do private(i,j)
DO J=JSTA,JEND
DO I=ISTA,IEND
GRID1(I,J) = HELI(I,J,1)
! GRID1(I,J) = HELI(I,J,2)
ENDDO
ENDDO
if(grib=='grib2') then
Expand Down Expand Up @@ -3846,8 +3847,17 @@ SUBROUTINE MISCLN
ENDIF
ENDDO
ENDDO

DO J=JSTA,JEND
DO I=ISTA,IEND
LLOW(I,J) = EL_BASE(I,J)
LLOW_ZINT(I,J)=ZINT(I,J,LLOW(I,J))
IEQL_ZINT(I,J)=ZINT(I,J,IEQL(I,J))
Z_TEMP(I,J)=LLOW_ZINT(I,J)+D50*(IEQL_ZINT(I,J)-LLOW_ZINT(I,J))
MIDCAL(I,J,L)=ABS(ZINT(I,J,L)-Z_TEMP(I,J))
ENDDO
ENDDO
ENDDO
Z_MIDCAL=MINLOC(MIDCAL,DIM=3)

!
!get surface height
Expand Down Expand Up @@ -3955,11 +3965,7 @@ SUBROUTINE MISCLN
DO J=JSTA,JEND
DO I=ISTA,IEND
IF(LLOW(I,J)<spval.and.LUPP(I,J)<spval) THEN
MIDCAL=INT(LLOW(I,J)+D50*(LUPP(I,J)-LLOW(I,J)))
!mid-layer
!vertical
!index
UVECT(I,J)=UH(I,J,MIDCAL)-UH(I,J,LLOW(I,J))
UVECT(I,J)=UH(I,J,Z_MIDCAL(I,J))-UH(I,J,LLOW(I,J))
GRID1(I,J)=UVECT(I,J)
ENDIF
ENDDO
Expand All @@ -3984,13 +3990,8 @@ SUBROUTINE MISCLN
GRID1=spval
DO J=JSTA,JEND
DO I=ISTA,IEND
IF(LLOW(I,J)<spval.and.LUPP(I,J)<spval.and.&
VH(I,J,MIDCAL)<spval.and.VH(I,J,LLOW(I,J))<spval)THEN
MIDCAL=INT(LLOW(I,J)+D50*(IEQL(I,J)-LLOW(I,J)))
!mid-layer
!vertical
!index
VVECT(I,J)=VH(I,J,MIDCAL)-VH(I,J,LLOW(I,J))
IF(LLOW(I,J)<spval.and.LUPP(I,J)<spval) THEN
VVECT(I,J)=VH(I,J,Z_MIDCAL(I,J))-VH(I,J,LLOW(I,J))
GRID1(I,J)=VVECT(I,J)
ENDIF
ENDDO
Expand Down Expand Up @@ -4039,6 +4040,13 @@ SUBROUTINE MISCLN
ENDIF

! Effective Helicity
!$omp parallel do private(i,j)
DO J=JSTA,JEND
DO I=ISTA,IEND
LLOW(I,J) = EL_BASE(I,J)
LUPP(I,J) = EL_TOPS(I,J)
ENDDO
ENDDO

CALL CALHEL3(LLOW,LUPP,EFFUST,EFFVST,ESRH)

Expand Down Expand Up @@ -4551,6 +4559,8 @@ SUBROUTINE MISCLN
if (allocated(wbnd)) deallocate(wbnd)
if (allocated(lvlbnd)) deallocate(lvlbnd)
if (allocated(lb2)) deallocate(lb2)
if (allocated(el_base)) deallocate(el_base)
if (allocated(el_tops)) deallocate(el_tops)
!
!
! RELATIVE HUMIDITY WITH RESPECT TO PRECIPITABLE WATER
Expand Down