Upp local memory (NOAA-EMC#284)

* improve UPP local memory allocation * improve UPP local memory allocation * improve UPP local memory allocation * improve UPP local memory allocation * Upp local memory
WenMeng-NOAA · Apr 5, 2021 · ed3ccf5 · ed3ccf5
1 parent ba66a7d
commit ed3ccf5
Show file tree

Hide file tree

Showing 23 changed files with 87 additions and 29 deletions.
diff --git a/sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f b/sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f
@@ -11,6 +11,7 @@
 !! -  19-04-01 Sharon NEBUDA - Added output option for GOES-16 & GOES-17 ABI IR Channels 7-16
 !! -  20-04-09 Tracy Hertneky - Added Himawari-8 AHI CH7-CH16
 !! -  21-01-10 Web Meng - Added checking points for skiping grids with filling value spval
+!! -  21-03-11 Bo Cui - improve local arrays memory
 !!
 !!   OUTPUT FILES:
 !!     NONE
@@ -2110,6 +2111,7 @@ SUBROUTINE CALRAD_WCLOUD
      if (error_status /= success) &
          print*,'ERROR*** crtm_destroy error_status=',error_status
      deallocate(channelinfo) 
+     if (allocated(model_to_crtm)) deallocate(model_to_crtm)
   endif ifactive ! for all iget logical
   return
 end SUBROUTINE CALRAD_WCLOUD

diff --git a/sorc/ncep_post.fd/CANRES.f b/sorc/ncep_post.fd/CANRES.f
@@ -15,6 +15,7 @@ SUBROUTINE CANRES(SOLAR,SFCTMP,Q2,SFCPRS,SMC,  &
 ! ----------------------------------------------------------------------
 ! PROGRAM HISTORY LOG:
 !   03-01-17  M EK AND H CHUANG - LIFTED IT FROM MODEL FOR POST 
+!   03-11-21  Bo Cui - improve local arrays memory
 ! ----------------------------------------------------------------------
 ! INPUT:  SOLAR: INCOMING SOLAR RADIATION
 ! 	  CH:	  SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE
@@ -319,5 +320,6 @@ SUBROUTINE CANRES(SOLAR,SFCTMP,Q2,SFCPRS,SMC,  &
 
       GC = 1./RC
 
+      deallocate(IROOT,RSMN,RGL,HS)
       RETURN
       END
diff --git a/sorc/ncep_post.fd/CLDRAD.f b/sorc/ncep_post.fd/CLDRAD.f
@@ -159,7 +159,9 @@ SUBROUTINE CLDRAD
       real                     :: ceiling_thresh_cldfra, cldfra_max, &
                                   zceil, zceil1, zceil2, previous_sum, &
                                   ceil_min, ceil_neighbor
+
       real,dimension(im,jm)    :: ceil
+
 !     B ZHOU: For aviation:
       REAL, dimension(im,jsta:jend) :: TCLD, CEILING
       real   CU_ir(LM), q_conv   !bsf

diff --git a/sorc/ncep_post.fd/INITPOST.F b/sorc/ncep_post.fd/INITPOST.F
@@ -16,6 +16,7 @@
 !!   01-10-25  H CHUANG - MODIFIED TO PROCESS HYBRID MODEL OUTPUT
 !!   02-06-19  MIKE BALDWIN - WRF VERSION
 !!   02-08-15  H CHUANG - UNIT CORRECTION AND GENERALIZE PROJECTION OPTIONS
+!!   21-03-11  Bo Cui - change local arrays to dimension (im,jsta:jend)
 !!     
 !! USAGE:    CALL INIT
 !!   INPUT ARGUMENT LIST:
@@ -116,7 +117,8 @@ SUBROUTINE INITPOST
 !     
       REAL RINC(5)
       REAL DUMMY ( IM, JM )
-      REAL DUMMY2 ( IM, JM ), MSFT(IM,JM)
+      REAL DUMMY2 ( IM, JM )
+      real, allocatable::  msft(:,:)
       INTEGER IDUMMY ( IM, JM )
       REAL,allocatable ::  DUM3D ( :, :, : )
 !      REAL DUM3D2 ( IM+1, JM+1, LM+1 )
@@ -2900,6 +2902,9 @@ SUBROUTINE INITPOST
 ! obtain map scale factor
 !      VarName='msft'
       VarName='MAPFAC_M'
+
+      allocate(msft(IM,jsta_2l:jend_2u))
+
       call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY,        &  
         IM,1,JM,1,IM,JS,JE,1)
        do j = jsta_2l, jend_2u
@@ -3026,6 +3031,7 @@ SUBROUTINE INITPOST
         print*,'sample dx,dy,msft=',ii,jj,dx(ii,jj),dy(ii,jj)           &
         ,msft(ii,jj)
 
+
 ! Convert DXVAL and DYVAL for ARW rotated latlon from meters to radian
         if(maptype==6)then
          dxval=(DXVAL * 360.)/(ERAD*2.*pi)*gdsdegr
@@ -3242,6 +3248,7 @@ SUBROUTINE INITPOST
         end if
 !     
       DEALLOCATE (THV)
+      deallocate (msft)
 
 !
 ! convert  dxval, dyval from mtere to mm

diff --git a/sorc/ncep_post.fd/INITPOST_GFS.f b/sorc/ncep_post.fd/INITPOST_GFS.f
@@ -7,6 +7,9 @@
 !!   VARIABLES AT THE START OF AN ETA MODEL OR POST 
 !!   PROCESSOR RUN.
 !!
+!! PROGRAM HISTORY LOG:
+!!   21-03-11  Bo Cui - change local arrays to dimension (im,jsta:jend)
+!!
 !! USAGE:    CALL INIT
 !!   INPUT ARGUMENT LIST:
 !!     NONE     
@@ -124,8 +127,7 @@ SUBROUTINE INITPOST_GFS(NREC,iunit,iostatusFlux,iunitd3d,iostatusD3D,gfile)
       REAL DUM1D (LM+1)
       REAL DUMMY ( IM, JM )
       REAL DUMMY2 ( IM, JM )
-      REAL FI(IM,JM,2)
-      INTEGER IDUMMY ( IM, JM )
+      REAL FI(im,jsta_2l:jend_2u,2) 
 !jw
       integer ii,jj,js,je,jev,iyear,imn,iday,itmp,ioutcount,istatus, &
               I,J,L,ll,k,kf,irtn,igdout,n,Index

diff --git a/sorc/ncep_post.fd/INITPOST_GFS_NEMS.f b/sorc/ncep_post.fd/INITPOST_GFS_NEMS.f
@@ -15,6 +15,7 @@
 !!   2015-03-16 S. Moorthi  adding gocart_on option
 !!   2015-03-18 S. Moorthi  Optimization including threading
 !!   2015-08-17 S. Moorthi  Add TKE for NEMS/GSM
+!!   2021-03-11 Bo Cui      change local arrays to dimension (im,jsta:jend)
 !!
 !! USAGE:    CALL INIT
 !!   INPUT ARGUMENT LIST:
@@ -137,7 +138,8 @@ SUBROUTINE INITPOST_GFS_NEMS(NREC,iostatusFlux,iostatusD3D,   &
       integer nfhour ! forecast hour from nems io file
       REAL RINC(5)
 
-      REAL DUMMY(IM,JM), DUMMY2(IM,JM), FI(IM,JM,2)
+      REAL DUMMY(IM,JM), DUMMY2(IM,JM)
+      real, allocatable :: fi(:,:,:)
 !jw
       integer ii,jj,js,je,iyear,imn,iday,itmp,ioutcount,istatus,       &
               I,J,L,ll,k,kf,irtn,igdout,n,Index,nframe,                &
@@ -859,6 +861,7 @@ SUBROUTINE INITPOST_GFS_NEMS(NREC,iostatusFlux,iostatusD3D,   &
       endif
 
       allocate(wrk1(im,jsta:jend),wrk2(im,jsta:jend))
+      allocate(fi(im,jsta:jend,2))
 
 !$omp parallel do private(i,j)
       do j=jsta,jend
@@ -913,7 +916,7 @@ SUBROUTINE INITPOST_GFS_NEMS(NREC,iostatusFlux,iostatusD3D,   &
           'alpint=',ALPINT(ii,jj,l),'pmid=',LOG(PMID(Ii,Jj,L)),'pmid(l-1)=',    &
           LOG(PMID(Ii,Jj,L-1)),'zmd=',ZMID(Ii,Jj,L),'zmid(l-1)=',ZMID(Ii,Jj,L-1)
       ENDDO
-      deallocate(wrk1,wrk2)
+      deallocate(wrk1,wrk2,fi)
 
 
       if (gocart_on) then

diff --git a/sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f b/sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f
@@ -21,6 +21,7 @@
 !!                          and reduce memory in divergence calculatiom
 !!   2016-07-21 Jun Wang    change averaged field name with suffix
 !!   2019-07-24 Li(Kate) Zhang - Merge and update NGAC UPP into FV3-Chem
+!!   2021-03-11 Bo Cui   change local arrays to dimension (im,jsta:jend)
 !!
 !! USAGE:    CALL INIT
 !!   INPUT ARGUMENT LIST:
@@ -153,7 +154,8 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
       real dtp !physics time step
       REAL RINC(5)
 
-      REAL DUMMY(IM,JM), DUMMY2(IM,JM), FI(IM,JM,2)
+      REAL DUMMY(IM,JM)
+      real, allocatable :: fi(:,:,:)
 !jw
       integer ii,jj,js,je,iyear,imn,iday,itmp,ioutcount,istatus,       &
               I,J,L,ll,k,kf,irtn,igdout,n,Index,nframe,                &
@@ -1240,6 +1242,7 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
 
 !
       allocate(wrk1(im,jsta:jend),wrk2(im,jsta:jend))
+      allocate(fi(im,jsta:jend,2))
 
       do j=jsta,jend
         do i=1,im
@@ -1291,7 +1294,7 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
            'pmid(l-1)=',LOG(PMID(Ii,Jj,L-1)),'zmd=',ZMID(Ii,Jj,L), &
            'zmid(l-1)=',ZMID(Ii,Jj,L-1)
         ENDDO
-        deallocate(wrk1,wrk2)
+        deallocate(wrk1,wrk2,fi)
       else 
         do l=lm,1,-1
           do j=jsta,jend

diff --git a/sorc/ncep_post.fd/INITPOST_GFS_NETCDF.f b/sorc/ncep_post.fd/INITPOST_GFS_NETCDF.f
@@ -9,6 +9,7 @@
 !!
 !! REVISION HISTORY
 !!   2017-08-11 H Chuang   start from INITPOST_GFS_NEMS_MPIIO.f 
+!!   2021-03-11 Bo Cui     change local arrays to dimension (im,jsta:jend)
 !!
 !! USAGE:    CALL INITPOST_NETCDF
 !!   INPUT ARGUMENT LIST:
@@ -141,7 +142,9 @@ SUBROUTINE INITPOST_GFS_NETCDF(ncid3d)
       real dtp !physics time step
       REAL RINC(5)
 
-      REAL DUMMY(IM,JM), DUMMY2(IM,JM), FI(IM,JM,2)
+!     REAL FI(IM,JM,2)
+      REAL DUMMY(IM,JM)
+
 !jw
       integer ii,jj,js,je,iyear,imn,iday,itmp,ioutcount,istatus,       &
               I,J,L,ll,k,kf,irtn,igdout,n,Index,nframe,                &

diff --git a/sorc/ncep_post.fd/INITPOST_GFS_NETCDF_PARA.f b/sorc/ncep_post.fd/INITPOST_GFS_NETCDF_PARA.f
@@ -9,6 +9,7 @@
 !!
 !! REVISION HISTORY
 !!   2020-02-04 W Meng   start from INITPOST_GFS_NETCDF.f 
+!!   2021-03-11 Bo Cui   change local arrays to dimension (im,jsta:jend)
 !!
 !! USAGE:    CALL INITPOST_GFS_NETCDF_PARA
 !!   INPUT ARGUMENT LIST:
@@ -141,7 +142,7 @@ SUBROUTINE INITPOST_GFS_NETCDF_PARA(ncid3d)
       real dtp !physics time step
       REAL RINC(5)
 
-      REAL DUMMY(IM,JM), DUMMY2(IM,JM), FI(IM,JM,2)
+      REAL DUMMY(IM,JM)
 !jw
       integer ii,jj,js,je,iyear,imn,iday,itmp,ioutcount,istatus,       &
               I,J,L,ll,k,kf,irtn,igdout,n,Index,nframe,                &

diff --git a/sorc/ncep_post.fd/INITPOST_GFS_SIGIO.f b/sorc/ncep_post.fd/INITPOST_GFS_SIGIO.f
@@ -11,6 +11,7 @@
 !!   2011-02-07 Jun Wang    add grib2 option
 !!   2013-04-19 Jun Wang    add changes to read wam tracers
 !!   2013-05-04 Shrinivas Moorthi: real * 8 for pm1d and pi1d and pt=100hPa and some cosmetic changes
+!!   2021-03-11 Bo Cui  change local arrays to dimension (im,jsta:jend)
 !!
 !! USAGE:    CALL INIT
 !!   INPUT ARGUMENT LIST:
@@ -162,7 +163,8 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead)
                              p2d(:,:), t2d(:,:), q2d(:,:),  qs2d(:,:),      &
                              cw2d(:,:), cfr2d(:,:)
       real*8, allocatable :: pm2d(:,:), pi2d(:,:)
-      REAL FI(IM,JM,2)
+      real, allocatable :: fi(:,:,:)
+
 !     INTEGER IDUMMY(IM,JM)
 !jw
       integer ii,jj,js,je,iyear,imn,iday,itmp,ioutcount,istatus, &
@@ -767,6 +769,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead)
       deallocate (d2d,u2d,v2d,pi2d,pm2d,omga2d)
 
       allocate(wrk1(im,jsta:jend),wrk2(im,jsta:jend))
+      allocate(fi(im,jsta:jend,2))
 
 !$omp parallel do private(i,j)
       do j=jsta,jend
@@ -824,7 +827,7 @@ SUBROUTINE INITPOST_GFS_SIGIO(lusig,iunit,iostatusFlux,iostatusD3D,idrt,sighead)
           'alpint=',ALPINT(ii,jj,l),'pmid=',LOG(PMID(Ii,Jj,L)),'pmid(l-1)=', &
           LOG(PMID(Ii,Jj,L-1)),'zmd=',ZMID(Ii,Jj,L),'zmid(l-1)=',ZMID(Ii,Jj,L-1)
       ENDDO      
-      deallocate(wrk1,wrk2)
+      deallocate(wrk1,wrk2,fi)
 
 !     write(0,*)'af sigma file'
 ! start retrieving data using getgb, first land/sea mask

diff --git a/sorc/ncep_post.fd/INITPOST_NEMS.f b/sorc/ncep_post.fd/INITPOST_NEMS.f
@@ -7,6 +7,9 @@
 !!   VARIABLES AT THE START OF AN NEMS MODEL OR POST 
 !!   PROCESSOR RUN.
 !!     
+!! REVISION HISTORY
+!!   21-03-11  Bo Cui - change local arrays to dimension (im,jsta:jend)
+!!
 !! USAGE:    CALL INITPOST_NEMS
 !!   INPUT ARGUMENT LIST:
 !!     NREC
@@ -106,8 +109,8 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile)
       REAL DUM1D (LM+1)
       REAL DUMMY ( IM, JM )
       REAL DUMMY2 ( IM, JM )
-      REAL FI(IM,JM,2)
-      INTEGER IDUMMY ( IM, JM )
+      real, allocatable :: fi(:,:,:)
+
       integer ibuf(im,jsta_2l:jend_2u)
       real buf(im,jsta_2l:jend_2u)
       character*8,allocatable:: recname(:)
@@ -1911,6 +1914,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile)
       end if  
 
 !!!!! COMPUTE Z
+       allocate(fi(im,jsta_2l:jend_2u,2))
        do j = jsta, jend
         do i = 1, im
             ZINT(I,J,LM+1) = FIS(I,J)/G
@@ -1947,6 +1951,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile)
         write(0,*)' pmid lbounds=',lbound(pmid),' ubounds=',ubound(pmid)
         write(0,*)' pint lbounds=',lbound(pint),' ubounds=',ubound(pint)
       endif
+      deallocate(fi)
 !
       DO L=1,LM
 !      write(0,*)' zmid l=',l

diff --git a/sorc/ncep_post.fd/INITPOST_NEMS_MPIIO.f b/sorc/ncep_post.fd/INITPOST_NEMS_MPIIO.f
@@ -7,6 +7,9 @@
 !!   VARIABLES AT THE START OF AN NEMS MODEL OR POST 
 !!   PROCESSOR RUN.
 !!     
+!! REVISION HISTORY
+!!   21-03-11  Bo Cui - change local arrays to dimension (im,jsta:jend)
+!!
 !! USAGE:    CALL INITPOST_NEMS
 !!   INPUT ARGUMENT LIST:
 !!     NREC
@@ -111,9 +114,8 @@ SUBROUTINE INITPOST_NEMS_MPIIO()
       REAL GARB
       REAL DUM1D (LM+1)
       REAL DUMMY ( IM, JM )
-      REAL DUMMY2 ( IM, JM )
-      REAL FI(IM,JM,2)
-      INTEGER IDUMMY ( IM, JM )
+!     REAL DUMMY2 ( IM, JM )
+      real, allocatable :: fi(:,:,:)
       integer ibuf(im,jsta_2l:jend_2u)
       real buf(im,jsta_2l:jend_2u)
       character*8,allocatable:: recname(:)
@@ -1612,6 +1614,7 @@ SUBROUTINE INITPOST_NEMS_MPIIO()
       end if  
       write(0,*)' after PMIDV'
 
+      allocate(fi(im,jsta:jend,2))
 
 !!!!! COMPUTE Z
        do j = jsta, jend
@@ -1639,6 +1642,9 @@ SUBROUTINE INITPOST_NEMS_MPIIO()
         ENDDO
        ENDDO
       END DO
+
+      deallocate(fi)
+
       print*,'finish deriving geopotential in nmm'
       write(0,*)' after ZINT lm=',lm,' js=',js,' je=',je,' im=',im
       write(0,*)' zmid lbounds=',lbound(zmid),' ubounds=',ubound(zmid)

diff --git a/sorc/ncep_post.fd/INITPOST_NETCDF.f b/sorc/ncep_post.fd/INITPOST_NETCDF.f
@@ -9,6 +9,7 @@
 !!
 !! REVISION HISTORY
 !!   2017-08-11 H Chuang   start from INITPOST_GFS_NEMS_MPIIO.f 
+!!   2021-03-11 Bo Cui     change local arrays to dimension (im,jsta:jend)
 !!
 !! USAGE:    CALL INITPOST_NETCDF
 !!   INPUT ARGUMENT LIST:
@@ -143,7 +144,7 @@ SUBROUTINE INITPOST_NETCDF(ncid3d)
       real dtp !physics time step
       REAL RINC(5)
 
-      REAL DUMMY(IM,JM), DUMMY2(IM,JM), FI(IM,JM,2)
+      REAL DUMMY(IM,JM)
 !jw
       integer ii,jj,js,je,iyear,imn,iday,itmp,ioutcount,istatus,       &
               I,J,L,ll,k,kf,irtn,igdout,n,Index,nframe,                &

diff --git a/sorc/ncep_post.fd/INITPOST_NMM.f b/sorc/ncep_post.fd/INITPOST_NMM.f
@@ -19,6 +19,7 @@
 !!   03-07-25  H CHUANG - MODIFIED TO PROCESS NMM WRF
 !!   05-12-05  H CHUANG - ADD CAPABILITY TO OUTPUT OFF-HOUR FORECAST WHICH HAS
 !!               NO INPACTS ON ON-HOUR FORECAST
+!!   21-03-11  Bo Cui - change local arrays to dimension (im,jsta:jend)
 !!     
 !! USAGE:    CALL INIT
 !!   INPUT ARGUMENT LIST:
@@ -104,8 +105,8 @@ SUBROUTINE INITPOST_NMM
       REAL RINC(5)
       REAL ETA1(LM), ETA2(LM)
       REAL DUMMY ( IM, JM )
-      REAL DUMMY2 ( IM, JM )
-      REAL FI(IM,JM,2)
+!     REAL DUMMY2 ( IM, JM )
+      real, allocatable :: fi(:,:,:)
       REAL DUM3D ( IM+1, JM+1, LM+1 )
       REAL DUM3D2 ( IM+1, JM+1, LM+1 )
 !mp
@@ -798,6 +799,7 @@ SUBROUTINE INITPOST_NMM
       VarName='FIS'
       call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY,       &   
         IM,1,JM,1,IM,JS,JE,1)
+       allocate(fi(im,jsta:jend,2))
        do j = jsta_2l, jend_2u
         do i = 1, im
             FIS ( i, j ) = dummy ( i, j ) 
@@ -822,6 +824,7 @@ SUBROUTINE INITPOST_NMM
        ENDDO      
       END DO
       print*,'finish deriving geopotential in nmm'
+      deallocate(fi)
 !
       DO L=1,LM
        DO I=1,IM

diff --git a/sorc/ncep_post.fd/MDL2AGL.f b/sorc/ncep_post.fd/MDL2AGL.f
@@ -13,6 +13,7 @@
 !!   11-03-04  J WANG  - ADD grib2 option
 !!   19-10-30  B CUI - REMOVE "GOTO" STATEMENT
 !!   20-03-25  J MENG - remove grib1 
+!!   21-03-11  B Cui - change local arrays to dimension (im,jsta:jend)
 !!     
 !! USAGE:    CALL MDL2P
 !!   INPUT ARGUMENT LIST:
@@ -74,7 +75,7 @@ SUBROUTINE MDL2AGL
 !     DECLARE VARIABLES.
 !     
       LOGICAL IOOMG,IOALL
-      REAL,dimension(im,jm)              :: grid1
+      REAL,dimension(im,jsta_2l:jend_2u) :: grid1                                 
       REAL,dimension(im,jsta_2l:jend_2u) :: UAGL, VAGL, tagl, pagl, qagl
 !
       INTEGER,dimension(im,jsta_2l:jend_2u) :: NL1X