From 9b911b25f48f150e02d4b3132c4410f1be8ddc3b Mon Sep 17 00:00:00 2001 From: edward colon Date: Sat, 1 Apr 2023 21:09:29 +0000 Subject: [PATCH 1/5] MISCLN.f updated to resolve issues in generating SPC fields using RRFS-derived analysis output files. --- sorc/ncep_post.fd/MISCLN.f | 76 ++++++++++++++++---------------------- 1 file changed, 32 insertions(+), 44 deletions(-) diff --git a/sorc/ncep_post.fd/MISCLN.f b/sorc/ncep_post.fd/MISCLN.f index b61376b59..cd26be3df 100644 --- a/sorc/ncep_post.fd/MISCLN.f +++ b/sorc/ncep_post.fd/MISCLN.f @@ -146,7 +146,7 @@ SUBROUTINE MISCLN UBND, VBND, RHBND, & WBND, T7D, Q7D, & U7D, V6D, P7D, & - ICINGFD,GTGFD,CATFD,MWTFD + ICINGFD,GTGFD,CATFD,MWTFD,MIDCAL real, dimension(:,:),allocatable :: QM8510, RH4710, RH8498, & RH4796, RH1847, UST, VST, & @@ -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 @@ -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 @@ -1206,28 +1207,6 @@ SUBROUTINE MISCLN 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) - - ! Regional GTG has a legend of special defination - ! 0 m holds the max value of the whole vertical column - DO IFD = 1,NFDCTL - if(NINT(HTFDCTL(IFD)) == 0) then - N=IFD - exit - endif - ENDDO - DO IFD = 1,NFDCTL - DO J=JSTA,JEND - DO I=ISTA,IEND - work1=GTGFD(I,J,IFD) - if(GTGFD(I,J,N)>=SPVAL) then - GTGFD(I,J,N)=work1 - elseif(work10) THEN !$omp parallel do private(i,j) @@ -3724,7 +3703,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)) iget1 = IGET(953) iget2 = -1 iget3 = -1 @@ -3732,7 +3714,7 @@ SUBROUTINE MISCLN iget2 = LVLS(1,iget1) iget3 = LVLS(2,iget1) endif - if(me==0) write(*,*) '953 ',iget1,iget2,iget3 + if(me==0) write(0,*) '953 ',iget1,iget2,iget3 IF (iget1 > 0 .OR. IGET(162) > 0 .OR. IGET(953) > 0) THEN DEPTH(1) = 3000.0 DEPTH(2) = 1000.0 @@ -3768,7 +3750,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)) @@ -3778,7 +3759,6 @@ 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 @@ -3786,7 +3766,6 @@ SUBROUTINE MISCLN 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 @@ -3846,8 +3825,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 @@ -3955,11 +3943,7 @@ SUBROUTINE MISCLN DO J=JSTA,JEND DO I=ISTA,IEND IF(LLOW(I,J) Date: Mon, 3 Apr 2023 10:32:05 -0400 Subject: [PATCH 2/5] Update MISCLN.f --- sorc/ncep_post.fd/MISCLN.f | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/sorc/ncep_post.fd/MISCLN.f b/sorc/ncep_post.fd/MISCLN.f index cd26be3df..7fd5fefca 100644 --- a/sorc/ncep_post.fd/MISCLN.f +++ b/sorc/ncep_post.fd/MISCLN.f @@ -1205,8 +1205,30 @@ SUBROUTINE MISCLN HTFDCTL=pset%param(N)%level ! 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) + call FDLVL_MASS(ITYPEFDLVLCTL,NFDCTL,HTFDCTL,GTG,GTGFD +! print *, "GTG 467 Done GTGFD=",me,GTGFD(IM/2,jend,1:NFDCTL) + + ! Regional GTG has a legend of special defination + ! 0 m holds the max value of the whole vertical column + DO IFD = 1,NFDCTL + if(NINT(HTFDCTL(IFD)) == 0) then + N=IFD + exit + endif + ENDDO + DO IFD = 1,NFDCTL + DO J=JSTA,JEND + DO I=ISTA,IEND + work1=GTGFD(I,J,IFD) + if(GTGFD(I,J,N)>=SPVAL) then + GTGFD(I,J,N)=work1 + elseif(work10) THEN !$omp parallel do private(i,j) From 56521de50df75832db49d312d6594b0905ceeb9d Mon Sep 17 00:00:00 2001 From: EdwardColon-NOAA Date: Mon, 3 Apr 2023 11:00:45 -0400 Subject: [PATCH 3/5] Update MISCLN.f --- sorc/ncep_post.fd/MISCLN.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sorc/ncep_post.fd/MISCLN.f b/sorc/ncep_post.fd/MISCLN.f index 7fd5fefca..98a53ecda 100644 --- a/sorc/ncep_post.fd/MISCLN.f +++ b/sorc/ncep_post.fd/MISCLN.f @@ -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: !! @@ -1205,7 +1205,7 @@ SUBROUTINE MISCLN HTFDCTL=pset%param(N)%level ! print *, "GTG 467 levels=",pset%param(N)%level allocate(GTGFD(ISTA:IEND,JSTA:JEND,NFDCTL)) - call FDLVL_MASS(ITYPEFDLVLCTL,NFDCTL,HTFDCTL,GTG,GTGFD + call FDLVL_MASS(ITYPEFDLVLCTL,NFDCTL,HTFDCTL,GTG,GTGFD) ! print *, "GTG 467 Done GTGFD=",me,GTGFD(IM/2,jend,1:NFDCTL) ! Regional GTG has a legend of special defination @@ -3736,7 +3736,7 @@ SUBROUTINE MISCLN iget2 = LVLS(1,iget1) iget3 = LVLS(2,iget1) endif - if(me==0) write(0,*) '953 ',iget1,iget2,iget3 + if(me==0) write(*,*) '953 ',iget1,iget2,iget3 IF (iget1 > 0 .OR. IGET(162) > 0 .OR. IGET(953) > 0) THEN DEPTH(1) = 3000.0 DEPTH(2) = 1000.0 From 52a258db8f06487abb0db3d6f924dfc79bcd1d60 Mon Sep 17 00:00:00 2001 From: EdwardColon-NOAA Date: Wed, 5 Apr 2023 13:15:03 -0400 Subject: [PATCH 4/5] Update MISCLN.f --- sorc/ncep_post.fd/MISCLN.f | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/sorc/ncep_post.fd/MISCLN.f b/sorc/ncep_post.fd/MISCLN.f index 98a53ecda..c9919a17e 100644 --- a/sorc/ncep_post.fd/MISCLN.f +++ b/sorc/ncep_post.fd/MISCLN.f @@ -4548,6 +4548,12 @@ SUBROUTINE MISCLN if (allocated(esrh)) deallocate(esrh) if (allocated(htsfc)) deallocate(htsfc) if (allocated(fshr)) deallocate(fshr) + if (allocated(llow_zint)) deallocate(llow_zint) + if (allocated(ieql_zint)) deallocate(ieql_zint) + if (allocated(z_temp)) deallocate(z_temp) + if (allocated(midcal)) deallocate(midcal) + if (allocated(z_midcal)) deallocate(z_midcal) + ENDIF if (allocated(pbnd)) deallocate(pbnd) From 9cf4858497de60c65ad7e7485f4ebd1cbcb695a1 Mon Sep 17 00:00:00 2001 From: EdwardColon-NOAA Date: Wed, 5 Apr 2023 13:29:59 -0400 Subject: [PATCH 5/5] Update MISCLN.f --- sorc/ncep_post.fd/MISCLN.f | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/sorc/ncep_post.fd/MISCLN.f b/sorc/ncep_post.fd/MISCLN.f index c9919a17e..6fc24544f 100644 --- a/sorc/ncep_post.fd/MISCLN.f +++ b/sorc/ncep_post.fd/MISCLN.f @@ -4553,6 +4553,8 @@ SUBROUTINE MISCLN if (allocated(z_temp)) deallocate(z_temp) if (allocated(midcal)) deallocate(midcal) if (allocated(z_midcal)) deallocate(z_midcal) + if (allocated(el_base)) deallocate(el_base) + if (allocated(el_tops)) deallocate(el_tops) ENDIF @@ -4565,8 +4567,7 @@ 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