From 816adc8393130c4323dd8fffd5d50b316f86c896 Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Tue, 22 Jun 2021 16:34:48 -0600 Subject: [PATCH 01/17] Clean up in/out argument declarations --- sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index e2e0ada90..aeb8079e3 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -156,7 +156,8 @@ endif - + write(*,*)'DEBUG: CALL TERSUB' + CALL TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, & OUTGRID,INPUTOROG) STOP @@ -184,20 +185,17 @@ !! @author Jordan Alpert NOAA/EMC SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, & OUTGRID,INPUTOROG) -!jaa use ipfort implicit none include 'netcdf.inc' C - integer :: IMN,JMN,IM,JM,NW + integer :: IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW character(len=*), intent(in) :: OUTGRID character(len=*), intent(in) :: INPUTOROG - integer :: NR,NF0,NF1 real, parameter :: MISSING_VALUE=-9999. real, PARAMETER :: PI=3.1415926535897931 integer :: efac, blat integer, PARAMETER :: NMT=14 INTEGER ZSLMX(2700,1350) - integer NM logical LATLONGRID INTEGER,allocatable:: ZAVG(:,:),ZSLM(:,:) REAL(4),allocatable:: GICE(:,:),OCLSM(:,:) @@ -244,6 +242,9 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, real WWW real :: timef,tbeg,tend,tbeg1 logical :: output_binary + + write(*,*)'DEBUG: in SUBROUTINE TERSUB' + output_binary = .false. tbeg1=timef() tbeg=timef() From c6f840751fcbac4d74a382e27e6bbd6bd9906e4d Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Tue, 22 Jun 2021 18:57:27 -0600 Subject: [PATCH 02/17] Organize variables by type --- .../orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 52 +++++++++++-------- 1 file changed, 29 insertions(+), 23 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index aeb8079e3..d7230e802 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -191,24 +191,34 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, integer :: IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW character(len=*), intent(in) :: OUTGRID character(len=*), intent(in) :: INPUTOROG + real, parameter :: MISSING_VALUE=-9999. real, PARAMETER :: PI=3.1415926535897931 - integer :: efac, blat integer, PARAMETER :: NMT=14 + + integer :: efac, blat + integer :: zsave1,zsave2,itopo,kount + integer :: kount2,islmx,jslmx,oldslm,msksrc,mskocn,notocn + integer IST(IM,jm),IEN(IM,jm),JST(JM),JEN(JM) + integer IWORK(IM,JM,4) INTEGER ZSLMX(2700,1350) - logical LATLONGRID - INTEGER,allocatable:: ZAVG(:,:),ZSLM(:,:) - REAL(4),allocatable:: GICE(:,:),OCLSM(:,:) - real :: DEGRAD + INTEGER KPDS(200),KGDS(200) integer*1,allocatable:: UMD(:,:) integer*1 i3save integer*2 glob(IMN,JMN), i2save - logical grid_from_file - INTEGER KPDS(200),KGDS(200), zsave1,zsave2,itopo,kount - INTEGER kount2,islmx,jslmx,oldslm,msksrc,mskocn,notocn + INTEGER,allocatable:: ZAVG(:,:),ZSLM(:,:) + integer i, j, nx, ny, ncid, js, jn, iw, ie, k + integer it,jt,i1,error,id_dim,id_var,nx_in,ny_in + integer i_south_pole,j_south_pole,i_north_pole,j_north_pole + integer fsize,wgta,IN,INW,INE,IS,ISW,ISE,M,N,IMT,IRET + integer numi(jm),ios,iosg,latg2,istat + integer maxc3,maxc4,maxc5,maxc6,maxc7,maxc8 + integer lonsperlat(jm/2),itest,jtest + + REAL(4),allocatable:: GICE(:,:),OCLSM(:,:) + real :: DEGRAD REAL COSCLT(JM),WGTCLT(JM),RCLT(JM),XLAT(JM),DIFFX(JM/2) REAL XLON(IM) - LOGICAL is_south_pole(IM,JM), is_north_pole(IM,JM) REAL GEOLON(IM,JM),GEOLAT(IM,JM) REAL, allocatable :: tmpvar(:,:) REAL GEOLON_C(IM+1,JM+1),GEOLAT_C(IM+1,JM+1) @@ -217,30 +227,26 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, REAL land_frac(IM,JM) REAL THETA(IM,JM),GAMMA(IM,JM),SIGMA(IM,JM),ELVMAX(IM,JM) REAL WZ4(IM,JM),VAR4(IM,JM),OA(IM,JM,4),OL(IM,JM,4),SLMI(IM,JM) - integer IST(IM,jm),IEN(IM,jm),JST(JM),JEN(JM) - integer IWORK(IM,JM,4) real WORK1(IM,JM),WORK2(IM,JM),WORK3(IM,JM),WORK4(IM,JM) real WORK5(IM,JM),WORK6(IM,JM),GLAT(JMN) - LOGICAL SPECTR, REVLAT, FILTER - logical fexist real HPRIME(IM,JM,14) real oaa(4),ola(4),sumdif,avedif,alon,alat real, allocatable :: oa_in(:,:,:), ol_in(:,:,:) real, allocatable :: slm_in(:,:), lon_in(:,:), lat_in(:,:) - integer numi(jm),ios,iosg,latg2,istat - integer maxc3,maxc4,maxc5,maxc6,maxc7,maxc8 - integer lonsperlat(jm/2),itest,jtest - integer i, j, nx, ny, ncid, js, jn, iw, ie, k - integer it,jt,i1,error,id_dim,id_var,nx_in,ny_in - integer i_south_pole,j_south_pole,i_north_pole,j_north_pole real maxlat, minlat - logical opened - logical LB(IM*JM) - integer fsize,wgta,IN,INW,INE,IS,ISW,ISE,M,N,IMT,IRET - complex ffj(im/2+1) real dlat,PHI,DELXN,RS,RN,slma,oroa,vara,var4a,xn,XS,FFF real WWW real :: timef,tbeg,tend,tbeg1 + + complex ffj(im/2+1) + + logical LATLONGRID + logical grid_from_file + LOGICAL is_south_pole(IM,JM), is_north_pole(IM,JM) + LOGICAL SPECTR, REVLAT, FILTER + logical fexist + logical opened + logical LB(IM*JM) logical :: output_binary write(*,*)'DEBUG: in SUBROUTINE TERSUB' From 0c1cb9cd1ae896c9e9120d2c2d0cf3df23ea4a33 Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Tue, 22 Jun 2021 19:05:19 -0600 Subject: [PATCH 03/17] Rearrange/consolidate integer declarations --- .../orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 30 +++++++++---------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index d7230e802..9fcfbac59 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -156,7 +156,7 @@ endif - write(*,*)'DEBUG: CALL TERSUB' + write(*,*)'DEBUG: CALL TERSUB 2' CALL TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, & OUTGRID,INPUTOROG) @@ -196,24 +196,24 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, real, PARAMETER :: PI=3.1415926535897931 integer, PARAMETER :: NMT=14 - integer :: efac, blat - integer :: zsave1,zsave2,itopo,kount + integer :: efac,blat,zsave1,zsave2,itopo,kount integer :: kount2,islmx,jslmx,oldslm,msksrc,mskocn,notocn - integer IST(IM,jm),IEN(IM,jm),JST(JM),JEN(JM) - integer IWORK(IM,JM,4) - INTEGER ZSLMX(2700,1350) - INTEGER KPDS(200),KGDS(200) + integer :: IST(IM,jm),IEN(IM,jm),JST(JM),JEN(JM) + integer :: IWORK(IM,JM,4) + INTEGER :: ZSLMX(2700,1350) + INTEGER :: KPDS(200),KGDS(200) integer*1,allocatable:: UMD(:,:) integer*1 i3save - integer*2 glob(IMN,JMN), i2save + integer*2 glob(IMN,JMN) + integer*2 i2save INTEGER,allocatable:: ZAVG(:,:),ZSLM(:,:) - integer i, j, nx, ny, ncid, js, jn, iw, ie, k - integer it,jt,i1,error,id_dim,id_var,nx_in,ny_in - integer i_south_pole,j_south_pole,i_north_pole,j_north_pole - integer fsize,wgta,IN,INW,INE,IS,ISW,ISE,M,N,IMT,IRET - integer numi(jm),ios,iosg,latg2,istat - integer maxc3,maxc4,maxc5,maxc6,maxc7,maxc8 - integer lonsperlat(jm/2),itest,jtest + integer :: i,j,nx,ny,ncid,js,jn,iw,ie,k,it,jt,i1,error,id_dim + integer :: id_var,nx_in,ny_in,fsize,wgta,IN,INW,INE,IS,ISW,ISE + integer :: M,N,IMT,IRET,ios,iosg,latg2,istat,itest,jtest + integer :: i_south_pole,j_south_pole,i_north_pole,j_north_pole + integer :: numi(jm) + integer :: maxc3,maxc4,maxc5,maxc6,maxc7,maxc8 + integer :: lonsperlat(jm/2) REAL(4),allocatable:: GICE(:,:),OCLSM(:,:) real :: DEGRAD From 75a30ed0a711dec3c5c309d10120a4646719328e Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Tue, 22 Jun 2021 20:28:37 -0600 Subject: [PATCH 04/17] Organize, consolidate, and standardize variable declarations --- .../orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 87 ++++++++++--------- 1 file changed, 44 insertions(+), 43 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index 9fcfbac59..e94eea512 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -156,7 +156,7 @@ endif - write(*,*)'DEBUG: CALL TERSUB 2' + write(*,*)'DEBUG: CALL TERSUB 3' CALL TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, & OUTGRID,INPUTOROG) @@ -198,56 +198,57 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, integer :: efac,blat,zsave1,zsave2,itopo,kount integer :: kount2,islmx,jslmx,oldslm,msksrc,mskocn,notocn - integer :: IST(IM,jm),IEN(IM,jm),JST(JM),JEN(JM) - integer :: IWORK(IM,JM,4) - INTEGER :: ZSLMX(2700,1350) - INTEGER :: KPDS(200),KGDS(200) - integer*1,allocatable:: UMD(:,:) - integer*1 i3save - integer*2 glob(IMN,JMN) - integer*2 i2save - INTEGER,allocatable:: ZAVG(:,:),ZSLM(:,:) integer :: i,j,nx,ny,ncid,js,jn,iw,ie,k,it,jt,i1,error,id_dim integer :: id_var,nx_in,ny_in,fsize,wgta,IN,INW,INE,IS,ISW,ISE integer :: M,N,IMT,IRET,ios,iosg,latg2,istat,itest,jtest integer :: i_south_pole,j_south_pole,i_north_pole,j_north_pole - integer :: numi(jm) integer :: maxc3,maxc4,maxc5,maxc6,maxc7,maxc8 - integer :: lonsperlat(jm/2) + integer(1) :: i3save + integer(2) :: i2save - REAL(4),allocatable:: GICE(:,:),OCLSM(:,:) - real :: DEGRAD - REAL COSCLT(JM),WGTCLT(JM),RCLT(JM),XLAT(JM),DIFFX(JM/2) - REAL XLON(IM) - REAL GEOLON(IM,JM),GEOLAT(IM,JM) - REAL, allocatable :: tmpvar(:,:) - REAL GEOLON_C(IM+1,JM+1),GEOLAT_C(IM+1,JM+1) - REAL DX(IM,JM),DY(IM,JM) - REAL SLM(IM,JM),ORO(IM,JM),VAR(IM,JM),ORS(NW),ORF(IM,JM) - REAL land_frac(IM,JM) - REAL THETA(IM,JM),GAMMA(IM,JM),SIGMA(IM,JM),ELVMAX(IM,JM) - REAL WZ4(IM,JM),VAR4(IM,JM),OA(IM,JM,4),OL(IM,JM,4),SLMI(IM,JM) - real WORK1(IM,JM),WORK2(IM,JM),WORK3(IM,JM),WORK4(IM,JM) - real WORK5(IM,JM),WORK6(IM,JM),GLAT(JMN) - real HPRIME(IM,JM,14) - real oaa(4),ola(4),sumdif,avedif,alon,alat + integer :: IST(IM,jm),IEN(IM,jm) + integer :: JST(JM),JEN(JM) + integer :: IWORK(IM,JM,4) + integer :: ZSLMX(2700,1350) + integer :: KPDS(200),KGDS(200) + integer :: numi(jm) + integer :: lonsperlat(jm/2) + integer(2) :: glob(IMN,JMN) + + integer, allocatable :: ZAVG(:,:),ZSLM(:,:) + integer(1), allocatable :: UMD(:,:) + + + real :: DEGRAD,maxlat, minlat,timef,tbeg,tend,tbeg1 + real :: dlat,PHI,DELXN,RS,RN,slma,oroa,vara,var4a,xn,XS,FFF,WWW + real :: sumdif,avedif,alon,alat + + real :: COSCLT(JM),WGTCLT(JM),RCLT(JM),XLAT(JM),DIFFX(JM/2) + real :: XLON(IM) + real :: GEOLON(IM,JM),GEOLAT(IM,JM) + real :: GEOLON_C(IM+1,JM+1),GEOLAT_C(IM+1,JM+1) + real :: DX(IM,JM),DY(IM,JM) + real :: SLM(IM,JM),ORO(IM,JM),VAR(IM,JM),ORS(NW),ORF(IM,JM) + real :: land_frac(IM,JM) + real :: THETA(IM,JM),GAMMA(IM,JM),SIGMA(IM,JM),ELVMAX(IM,JM) + real :: WZ4(IM,JM),VAR4(IM,JM),OA(IM,JM,4),OL(IM,JM,4),SLMI(IM,JM) + real :: WORK1(IM,JM),WORK2(IM,JM),WORK3(IM,JM),WORK4(IM,JM) + real :: WORK5(IM,JM),WORK6(IM,JM),GLAT(JMN) + real :: HPRIME(IM,JM,14) + real :: oaa(4),ola(4) + + real, allocatable :: tmpvar(:,:) real, allocatable :: oa_in(:,:,:), ol_in(:,:,:) real, allocatable :: slm_in(:,:), lon_in(:,:), lat_in(:,:) - real maxlat, minlat - real dlat,PHI,DELXN,RS,RN,slma,oroa,vara,var4a,xn,XS,FFF - real WWW - real :: timef,tbeg,tend,tbeg1 - - complex ffj(im/2+1) - - logical LATLONGRID - logical grid_from_file - LOGICAL is_south_pole(IM,JM), is_north_pole(IM,JM) - LOGICAL SPECTR, REVLAT, FILTER - logical fexist - logical opened - logical LB(IM*JM) - logical :: output_binary + real(4), allocatable:: GICE(:,:),OCLSM(:,:) + + complex :: ffj(im/2+1) + + logical :: LATLONGRID,grid_from_file,output_binary,fexist,opened + logical :: SPECTR, REVLAT, FILTER + + logical :: is_south_pole(IM,JM), is_north_pole(IM,JM) + logical :: LB(IM*JM) write(*,*)'DEBUG: in SUBROUTINE TERSUB' From 29fe67910648dc3b85eda1c66a520bf6357d816e Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Wed, 23 Jun 2021 16:18:33 -0600 Subject: [PATCH 05/17] Change all statically defined arrays to dynamically allocated arrays. I have no idea why this fixes the segfaults, but it does --- .../orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 73 ++++++++++++------- 1 file changed, 45 insertions(+), 28 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index e94eea512..d53a08315 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -206,36 +206,32 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, integer(1) :: i3save integer(2) :: i2save - integer :: IST(IM,jm),IEN(IM,jm) - integer :: JST(JM),JEN(JM) - integer :: IWORK(IM,JM,4) - integer :: ZSLMX(2700,1350) - integer :: KPDS(200),KGDS(200) - integer :: numi(jm) - integer :: lonsperlat(jm/2) - integer(2) :: glob(IMN,JMN) + integer, allocatable :: JST(:),JEN(:),KPDS(:),KGDS(:),numi(:) + integer, allocatable :: lonsperlat(:) + integer, allocatable :: IST(:,:),IEN(:,:),ZSLMX(:,:) integer, allocatable :: ZAVG(:,:),ZSLM(:,:) + integer, allocatable :: IWORK(:,:,:) integer(1), allocatable :: UMD(:,:) - + integer(2), allocatable :: glob(:,:) real :: DEGRAD,maxlat, minlat,timef,tbeg,tend,tbeg1 real :: dlat,PHI,DELXN,RS,RN,slma,oroa,vara,var4a,xn,XS,FFF,WWW real :: sumdif,avedif,alon,alat - real :: COSCLT(JM),WGTCLT(JM),RCLT(JM),XLAT(JM),DIFFX(JM/2) - real :: XLON(IM) - real :: GEOLON(IM,JM),GEOLAT(IM,JM) - real :: GEOLON_C(IM+1,JM+1),GEOLAT_C(IM+1,JM+1) - real :: DX(IM,JM),DY(IM,JM) - real :: SLM(IM,JM),ORO(IM,JM),VAR(IM,JM),ORS(NW),ORF(IM,JM) - real :: land_frac(IM,JM) - real :: THETA(IM,JM),GAMMA(IM,JM),SIGMA(IM,JM),ELVMAX(IM,JM) - real :: WZ4(IM,JM),VAR4(IM,JM),OA(IM,JM,4),OL(IM,JM,4),SLMI(IM,JM) - real :: WORK1(IM,JM),WORK2(IM,JM),WORK3(IM,JM),WORK4(IM,JM) - real :: WORK5(IM,JM),WORK6(IM,JM),GLAT(JMN) - real :: HPRIME(IM,JM,14) - real :: oaa(4),ola(4) + real, allocatable :: COSCLT(:),WGTCLT(:),RCLT(:),XLAT(:),DIFFX(:) + real, allocatable :: XLON(:),ORS(:),oaa(:),ola(:),GLAT(:) + + real, allocatable :: GEOLON(:,:),GEOLON_C(:,:),DX(:,:) + real, allocatable :: GEOLAT(:,:),GEOLAT_C(:,:),DY(:,:) + real, allocatable :: SLM(:,:),ORO(:,:),VAR(:,:),ORF(:,:) + real, allocatable :: land_frac(:,:) + real, allocatable :: THETA(:,:),GAMMA(:,:),SIGMA(:,:),ELVMAX(:,:) + real, allocatable :: WZ4(:,:),VAR4(:,:),SLMI(:,:) + real, allocatable :: WORK1(:,:),WORK2(:,:),WORK3(:,:),WORK4(:,:) + real, allocatable :: WORK5(:,:),WORK6(:,:) + + real, allocatable :: OA(:,:,:),OL(:,:,:),HPRIME(:,:,:) real, allocatable :: tmpvar(:,:) real, allocatable :: oa_in(:,:,:), ol_in(:,:,:) @@ -256,12 +252,33 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, tbeg1=timef() tbeg=timef() fsize = 65536 - - allocate (ZAVG(IMN,JMN)) - allocate (ZSLM(IMN,JMN)) - allocate (GICE(IMN+1,3601)) - allocate (UMD(IMN,JMN)) - allocate (OCLSM(IM,JM)) +! integers + allocate (JST(JM),JEN(JM),KPDS(200),KGDS(200),numi(jm)) + allocate (lonsperlat(jm/2)) + allocate (IST(IM,jm),IEN(IM,jm),ZSLMX(2700,1350)) + allocate (glob(IMN,JMN)) + allocate (IWORK(IM,JM,4)) + +! reals + allocate (COSCLT(JM),WGTCLT(JM),RCLT(JM),XLAT(JM),DIFFX(JM/2)) + allocate (XLON(IM),ORS(NW),oaa(4),ola(4),GLAT(JMN)) + + allocate (GEOLON(IM,JM),GEOLON_C(IM+1,JM+1),DX(IM,JM)) + allocate (GEOLAT(IM,JM),GEOLAT_C(IM+1,JM+1),DY(IM,JM)) + allocate (SLM(IM,JM),ORO(IM,JM),VAR(IM,JM),ORF(IM,JM)) + allocate (land_frac(IM,JM)) + allocate (THETA(IM,JM),GAMMA(IM,JM),SIGMA(IM,JM),ELVMAX(IM,JM)) + allocate (WZ4(IM,JM),VAR4(IM,JM),SLMI(IM,JM)) + allocate (WORK1(IM,JM),WORK2(IM,JM),WORK3(IM,JM),WORK4(IM,JM)) + allocate (WORK5(IM,JM),WORK6(IM,JM)) + + allocate (OA(IM,JM,4),OL(IM,JM,4),HPRIME(IM,JM,14)) + + allocate (ZAVG(IMN,JMN)) + allocate (ZSLM(IMN,JMN)) + allocate (GICE(IMN+1,3601)) + allocate (UMD(IMN,JMN)) + allocate (OCLSM(IM,JM)) ! ! SET CONSTANTS AND ZERO FIELDS From 0e6007cd33e4005841dee5b50b9ffbb78a64bfe5 Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Mon, 28 Jun 2021 15:37:28 -0600 Subject: [PATCH 06/17] Start adding/organizing "deallocate" statements --- .../orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 44 +++++++++++++------ 1 file changed, 30 insertions(+), 14 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index d53a08315..829a5a378 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -490,6 +490,8 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, enddo enddo END SELECT + + deallocate (UMD) ! --- ! --- Fixing an error in the topo 30" data set at pole (-9999). do i=1,imn @@ -526,6 +528,9 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! ! This code assumes that lat runs from north to south for gg! ! + + deallocate(lonsperlat) + print *,' SPECTR=',SPECTR,' REVLAT=',REVLAT,' ** with GICE-07 **' IF (SPECTR) THEN CALL SPLAT(4,JM,COSCLT,WGTCLT) @@ -617,14 +622,9 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, enddo enddo endif -! print *, -! & ' After GICE ZAVG(1,2)=',ZAVG(1,2),ZSLM(1,2) -! print *, -! & ' After GICE ZAVG(1,12)=',ZAVG(1,12),ZSLM(1,12) -! print *, -! & ' After GICE ZAVG(1,52)=',ZAVG(1,52),ZSLM(1,52) -! print *, -! & ' After GICE ZAVG(1,112)=',ZAVG(1,112),ZSLM(1,112) + + deallocate (GICE) + !C C COMPUTE MOUNTAIN DATA : ORO SLM VAR (Std Dev) OC C @@ -927,7 +927,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, CALL MAKEPC(ZAVG,ZSLM,THETA,GAMMA,SIGMA,GLAT, 1 IST,IEN,JST,JEN,IM,JM,IMN,JMN,XLAT,numi) endif - + call minmxj(IM,JM,THETA,' THETA') call minmxj(IM,JM,GAMMA,' GAMMA') call minmxj(IM,JM,SIGMA,' SIGMA') @@ -1060,13 +1060,25 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, 2 IM,JM,IMN,JMN,geolon_c,geolat_c, 3 geolon,geolat,is_south_pole,is_north_pole,nx_in,ny_in, 4 oa_in,ol_in,slm_in,lon_in,lat_in) - endif + + deallocate(oa_in,ol_in,slm_in,lon_in,lat_in) + + endif else CALL MAKEOA(ZAVG,VAR,GLAT,OA,OL,IWORK,ELVMAX,ORO, 1 WORK1,WORK2,WORK3,WORK4, 2 WORK5,WORK6, 3 IST,IEN,JST,JEN,IM,JM,IMN,JMN,XLAT,numi) endif + +! Deallocate 1d vars + deallocate(JST,JEN) + +! Deallocate 2d vars + deallocate (ZSLM) + deallocate (ZAVG) + + tbeg=timef() call minmxj(IM,JM,OA,' OA') call minmxj(IM,JM,OL,' OL') @@ -1553,6 +1565,9 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, print *,' ELVMAX: putgb-KPDS(22,5),iret:',KPDS(22),KPDS(5),IRET endif ! output_binary C + deallocate(KPDS,KGDS) + + DELXN = 360./IM do i=1,im xlon(i) = DELXN*(i-1) @@ -1582,10 +1597,10 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, print *,' wrote netcdf file out.oro.tile?.nc' print *,' ===== Deallocate Arrays and ENDING MTN VAR OROG program' - deallocate (ZAVG) - deallocate (ZSLM) - deallocate (UMD) - deallocate (GICE) + +! Deallocate 1d vars + deallocate(numi) + tend=timef() write(6,*)' Total runtime time= ',tend-tbeg1 RETURN @@ -3047,6 +3062,7 @@ SUBROUTINE MAKEOA2(ZAVG,zslm,VAR,GLAT,OA4,OL,IOA4,ELVMAX, ELVMAX(I,J) = ZMAX(I,J) ENDDO ENDDO + print *,'debug check 1' ! --- # of peaks > ZAVG value and ZMAX(IM,JM) -- ORO is already avg. ! --- to JM or to JM1 From e3a25df1e499900e93892591c5e31beb7e0f484a Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Mon, 28 Jun 2021 18:01:49 -0600 Subject: [PATCH 07/17] More rearranging of allocations and deallocations; this minor shuffle results in a 30% reduction in memory footprint! --- .../orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 40 +++++++------------ 1 file changed, 15 insertions(+), 25 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index 829a5a378..8b7821ed1 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -156,8 +156,6 @@ endif - write(*,*)'DEBUG: CALL TERSUB 3' - CALL TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, & OUTGRID,INPUTOROG) STOP @@ -246,8 +244,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, logical :: is_south_pole(IM,JM), is_north_pole(IM,JM) logical :: LB(IM*JM) - write(*,*)'DEBUG: in SUBROUTINE TERSUB' - output_binary = .false. tbeg1=timef() tbeg=timef() @@ -257,7 +253,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, allocate (lonsperlat(jm/2)) allocate (IST(IM,jm),IEN(IM,jm),ZSLMX(2700,1350)) allocate (glob(IMN,JMN)) - allocate (IWORK(IM,JM,4)) ! reals allocate (COSCLT(JM),WGTCLT(JM),RCLT(JM),XLAT(JM),DIFFX(JM/2)) @@ -272,13 +267,9 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, allocate (WORK1(IM,JM),WORK2(IM,JM),WORK3(IM,JM),WORK4(IM,JM)) allocate (WORK5(IM,JM),WORK6(IM,JM)) - allocate (OA(IM,JM,4),OL(IM,JM,4),HPRIME(IM,JM,14)) - allocate (ZAVG(IMN,JMN)) allocate (ZSLM(IMN,JMN)) - allocate (GICE(IMN+1,3601)) allocate (UMD(IMN,JMN)) - allocate (OCLSM(IM,JM)) ! ! SET CONSTANTS AND ZERO FIELDS @@ -397,8 +388,8 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, print *,' UBOUND ZAVG=',UBOUND(ZAVG) print *,' UBOUND glob=',UBOUND(glob) print *,' UBOUND ZSLM=',UBOUND(ZSLM) - print *,' UBOUND GICE=',UBOUND(GICE) - print *,' UBOUND OCLSM=',UBOUND(OCLSM) + print *,' UBOUND GICE=',IMN+1,3601 + print *,' UBOUND OCLSM=',IM,JM ! ! --- 0 is ocean and 1 is land for slm ! @@ -491,7 +482,8 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, enddo END SELECT - deallocate (UMD) +! Deallocate 2dvars + deallocate (ZSLMX,UMD,glob) ! --- ! --- Fixing an error in the topo 30" data set at pole (-9999). do i=1,imn @@ -529,8 +521,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! This code assumes that lat runs from north to south for gg! ! - deallocate(lonsperlat) - print *,' SPECTR=',SPECTR,' REVLAT=',REVLAT,' ** with GICE-07 **' IF (SPECTR) THEN CALL SPLAT(4,JM,COSCLT,WGTCLT) @@ -549,9 +539,9 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, XLAT(J) = 90.0 - RCLT(J) * DEGRAD ENDDO ENDIF + + allocate (GICE(IMN+1,3601)) ! -c print *,' cosclt=',cosclt -! print *,' RCLT(1)=',RCLT(1) sumdif = 0. DO J = JM/2,2,-1 DIFFX(J) = xlat(J) - XLAT(j-1) @@ -625,6 +615,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, deallocate (GICE) + allocate (OCLSM(IM,JM)) !C C COMPUTE MOUNTAIN DATA : ORO SLM VAR (Std Dev) OC C @@ -939,6 +930,9 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, C C COMPUTE MOUNTAIN DATA : OA OL C + allocate (IWORK(IM,JM,4)) + allocate (OA(IM,JM,4),OL(IM,JM,4),HPRIME(IM,JM,14)) + call minmxj(IM,JM,ORO,' ORO') print*, "inputorog=", trim(INPUTOROG) if(grid_from_file) then @@ -1061,7 +1055,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, 3 geolon,geolat,is_south_pole,is_north_pole,nx_in,ny_in, 4 oa_in,ol_in,slm_in,lon_in,lat_in) - deallocate(oa_in,ol_in,slm_in,lon_in,lat_in) + deallocate(oa_in,ol_in,slm_in,lon_in,lat_in,dx,dy) endif else @@ -1071,13 +1065,12 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, 3 IST,IEN,JST,JEN,IM,JM,IMN,JMN,XLAT,numi) endif -! Deallocate 1d vars - deallocate(JST,JEN) - ! Deallocate 2d vars deallocate (ZSLM) deallocate (ZAVG) +! Deallocate 3d vars + deallocate(IWORK) tbeg=timef() call minmxj(IM,JM,OA,' OA') @@ -1565,9 +1558,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, print *,' ELVMAX: putgb-KPDS(22,5),iret:',KPDS(22),KPDS(5),IRET endif ! output_binary C - deallocate(KPDS,KGDS) - - DELXN = 360./IM do i=1,im xlon(i) = DELXN*(i-1) @@ -1599,7 +1589,8 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, print *,' ===== Deallocate Arrays and ENDING MTN VAR OROG program' ! Deallocate 1d vars - deallocate(numi) + deallocate(JST,JEN,KPDS,KGDS,numi,lonsperlat) + deallocate(COSCLT,WGTCLT,RCLT,XLAT,DIFFX,XLON,ORS,oaa,ola,GLAT) tend=timef() write(6,*)' Total runtime time= ',tend-tbeg1 @@ -3062,7 +3053,6 @@ SUBROUTINE MAKEOA2(ZAVG,zslm,VAR,GLAT,OA4,OL,IOA4,ELVMAX, ELVMAX(I,J) = ZMAX(I,J) ENDDO ENDDO - print *,'debug check 1' ! --- # of peaks > ZAVG value and ZMAX(IM,JM) -- ORO is already avg. ! --- to JM or to JM1 From 58a1bd2520582d7d3091cc594c56a32b3c93dfc5 Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Mon, 28 Jun 2021 18:17:35 -0600 Subject: [PATCH 08/17] More rearrangement of allocate/deallocate statements, move element-wise assignment of one array to another out of a loop for faster execution --- .../orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 22 ++++++++++--------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index 8b7821ed1..207ffedf4 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -258,8 +258,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, allocate (COSCLT(JM),WGTCLT(JM),RCLT(JM),XLAT(JM),DIFFX(JM/2)) allocate (XLON(IM),ORS(NW),oaa(4),ola(4),GLAT(JMN)) - allocate (GEOLON(IM,JM),GEOLON_C(IM+1,JM+1),DX(IM,JM)) - allocate (GEOLAT(IM,JM),GEOLAT_C(IM+1,JM+1),DY(IM,JM)) allocate (SLM(IM,JM),ORO(IM,JM),VAR(IM,JM),ORF(IM,JM)) allocate (land_frac(IM,JM)) allocate (THETA(IM,JM),GAMMA(IM,JM),SIGMA(IM,JM),ELVMAX(IM,JM)) @@ -276,7 +274,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! DEGRAD = 180./PI SPECTR = NM .GT. 0 ! if NM <=0 grid is assumed lat/lon - FILTER = .TRUE. ! Spectr Filter defaults true and set by NF1 & NF0 + FILTER = .TRUE. ! Spectr Filter defaults true and set by NF1 ! MSKSRC = 0 ! MSKSRC=0 navy 10 lake msk, 1 UMD 30, -1 no lakes MSKSRC = 1 ! MSKSRC=0 navy 10 lake msk, 1 UMD 30, -1 no lakes REVLAT = BLAT .LT. 0 ! Reverse latitude/longitude for output @@ -395,7 +393,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! C ! --- ZSLM initialize with all land 1, ocean 0 -! ZSLM=1 +! ZSLM=1 do j=1,jmn do i=1,imn zslm(i,j)=1 @@ -427,7 +425,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, do j=1,jmn do i=1,imn if ( UMD(i,j) .eq. 0 ) ZSLM(i,j) = 0 - ZAVG(i,j) = glob(i,j) enddo enddo ! --- Global land in slm plus lakes on 30" grid and elev set over globe @@ -443,7 +440,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, do i=1,imn i1 = i + 1 ! --- slmsk with 10' lakes and set ZAVG from 30" glob - ZAVG(i,j) = glob(i,j) if ( glob(i,j) .eq. -9999 ) then ZSLM(i,j) = 0 kount = kount + 1 @@ -473,7 +469,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, do i=1,imn i1 = i + 1 ! --- UMD slmsk with 10' lakes and set ZAVG from 30" glob - ZAVG(i,j) = glob(i,j) if ( glob(i,j) .eq. -9999 ) then ZSLM(i,j) = 0 kount = kount + 1 @@ -680,6 +675,9 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, print *,' LSM:',OCLSM(1,1),OCLSM(50,50),OCLSM(75,75),OCLSM(IM,JM) endif + allocate (GEOLON(IM,JM),GEOLON_C(IM+1,JM+1),DX(IM,JM)) + allocate (GEOLAT(IM,JM),GEOLAT_C(IM+1,JM+1),DY(IM,JM)) + !--- reading grid file. grid_from_file = .false. is_south_pole = .false. @@ -1055,7 +1053,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, 3 geolon,geolat,is_south_pole,is_north_pole,nx_in,ny_in, 4 oa_in,ol_in,slm_in,lon_in,lat_in) - deallocate(oa_in,ol_in,slm_in,lon_in,lat_in,dx,dy) + deallocate(oa_in,ol_in,slm_in,lon_in,lat_in) endif else @@ -1066,8 +1064,8 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, endif ! Deallocate 2d vars - deallocate (ZSLM) - deallocate (ZAVG) + deallocate (ZSLM,ZAVG) + deallocate (dx,dy) ! Deallocate 3d vars deallocate(IWORK) @@ -1592,6 +1590,10 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, deallocate(JST,JEN,KPDS,KGDS,numi,lonsperlat) deallocate(COSCLT,WGTCLT,RCLT,XLAT,DIFFX,XLON,ORS,oaa,ola,GLAT) +! Deallocate 2d vars + deallocate (GEOLON,GEOLON_C,GEOLAT,GEOLAT_C) + + tend=timef() write(6,*)' Total runtime time= ',tend-tbeg1 RETURN From 3220f6bfeeb7411781b2158f2c0aaa7ed587423e Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Mon, 28 Jun 2021 18:37:50 -0600 Subject: [PATCH 09/17] More shuffling of allocations/deallocations --- sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index 207ffedf4..65f637ce1 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -258,8 +258,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, allocate (COSCLT(JM),WGTCLT(JM),RCLT(JM),XLAT(JM),DIFFX(JM/2)) allocate (XLON(IM),ORS(NW),oaa(4),ola(4),GLAT(JMN)) - allocate (SLM(IM,JM),ORO(IM,JM),VAR(IM,JM),ORF(IM,JM)) - allocate (land_frac(IM,JM)) allocate (THETA(IM,JM),GAMMA(IM,JM),SIGMA(IM,JM),ELVMAX(IM,JM)) allocate (WZ4(IM,JM),VAR4(IM,JM),SLMI(IM,JM)) allocate (WORK1(IM,JM),WORK2(IM,JM),WORK3(IM,JM),WORK4(IM,JM)) @@ -677,6 +675,8 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, allocate (GEOLON(IM,JM),GEOLON_C(IM+1,JM+1),DX(IM,JM)) allocate (GEOLAT(IM,JM),GEOLAT_C(IM+1,JM+1),DY(IM,JM)) + allocate (SLM(IM,JM),ORO(IM,JM),VAR(IM,JM)) + allocate (land_frac(IM,JM)) !--- reading grid file. grid_from_file = .false. @@ -1350,6 +1350,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! --- if no filter is desired then NF1=NF0=0 and ORF=ORO ! --- if no filter but spectral to grid (with gibbs) then NF1=jcap+2, and NF1=jcap+1 ! + allocate (ORF(IM,JM)) IF ( NF1 - NF0 .eq. 0 ) FILTER=.FALSE. print *,' NF1, NF0, FILTER=',NF1,NF0,FILTER IF (FILTER) THEN @@ -1592,6 +1593,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! Deallocate 2d vars deallocate (GEOLON,GEOLON_C,GEOLAT,GEOLAT_C) + deallocate (SLM,ORO,VAR,ORF,land_frac) tend=timef() From f7a7987fe8836c7410a0e7d9f13e83631d135545 Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Mon, 28 Jun 2021 18:39:25 -0600 Subject: [PATCH 10/17] Remove unnecessary loop over ZSLM --- sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index 65f637ce1..d566785d3 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -391,12 +391,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! C ! --- ZSLM initialize with all land 1, ocean 0 -! ZSLM=1 - do j=1,jmn - do i=1,imn - zslm(i,j)=1 - enddo - enddo + ZSLM=1 SELECTCASE(MSKSRC) C---- 30" sea land mask. 0 are water (lake or ocean) From 6249ab2ae59474b3b75d22d1eff24e315f0a7838 Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Tue, 29 Jun 2021 09:01:11 -0600 Subject: [PATCH 11/17] More variable allocation/deallocation shuffling, remove WZ4 variable which is unused --- sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index d566785d3..28d8f3d71 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -225,7 +225,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, real, allocatable :: SLM(:,:),ORO(:,:),VAR(:,:),ORF(:,:) real, allocatable :: land_frac(:,:) real, allocatable :: THETA(:,:),GAMMA(:,:),SIGMA(:,:),ELVMAX(:,:) - real, allocatable :: WZ4(:,:),VAR4(:,:),SLMI(:,:) + real, allocatable :: VAR4(:,:),SLMI(:,:) real, allocatable :: WORK1(:,:),WORK2(:,:),WORK3(:,:),WORK4(:,:) real, allocatable :: WORK5(:,:),WORK6(:,:) @@ -258,8 +258,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, allocate (COSCLT(JM),WGTCLT(JM),RCLT(JM),XLAT(JM),DIFFX(JM/2)) allocate (XLON(IM),ORS(NW),oaa(4),ola(4),GLAT(JMN)) - allocate (THETA(IM,JM),GAMMA(IM,JM),SIGMA(IM,JM),ELVMAX(IM,JM)) - allocate (WZ4(IM,JM),VAR4(IM,JM),SLMI(IM,JM)) allocate (WORK1(IM,JM),WORK2(IM,JM),WORK3(IM,JM),WORK4(IM,JM)) allocate (WORK5(IM,JM),WORK6(IM,JM)) @@ -603,7 +601,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, deallocate (GICE) - allocate (OCLSM(IM,JM)) + allocate (OCLSM(IM,JM),SLMI(IM,JM)) !C C COMPUTE MOUNTAIN DATA : ORO SLM VAR (Std Dev) OC C @@ -670,7 +668,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, allocate (GEOLON(IM,JM),GEOLON_C(IM+1,JM+1),DX(IM,JM)) allocate (GEOLAT(IM,JM),GEOLAT_C(IM+1,JM+1),DY(IM,JM)) - allocate (SLM(IM,JM),ORO(IM,JM),VAR(IM,JM)) + allocate (SLM(IM,JM),ORO(IM,JM),VAR(IM,JM),VAR4(IM,JM)) allocate (land_frac(IM,JM)) !--- reading grid file. @@ -901,6 +899,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, C C === Compute mtn principal coord HTENSR: THETA,GAMMA,SIGMA C + allocate (THETA(IM,JM),GAMMA(IM,JM),SIGMA(IM,JM),ELVMAX(IM,JM)) if(grid_from_file) then tbeg=timef() CALL MAKEPC2(ZAVG,ZSLM,THETA,GAMMA,SIGMA,GLAT, @@ -1190,6 +1189,8 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, print *,' SLM(itest,jtest)=',slm(itest,jtest),itest,jtest print *,' ORO(itest,jtest)=',oro(itest,jtest),itest,jtest + deallocate(SLMI) + C REMOVE ISOLATED POINTS DO J=2,JM-1 JN=J-1 @@ -1345,6 +1346,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! --- if no filter is desired then NF1=NF0=0 and ORF=ORO ! --- if no filter but spectral to grid (with gibbs) then NF1=jcap+2, and NF1=jcap+1 ! + deallocate(VAR4) allocate (ORF(IM,JM)) IF ( NF1 - NF0 .eq. 0 ) FILTER=.FALSE. print *,' NF1, NF0, FILTER=',NF1,NF0,FILTER @@ -1589,6 +1591,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! Deallocate 2d vars deallocate (GEOLON,GEOLON_C,GEOLAT,GEOLAT_C) deallocate (SLM,ORO,VAR,ORF,land_frac) + deallocate (THETA,GAMMA,SIGMA,ELVMAX) tend=timef() From c895b04e6d9c3893d3196026a4f68e15d91acec6 Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Tue, 29 Jun 2021 09:28:19 -0600 Subject: [PATCH 12/17] Finish allocation/deallocation shuffling, fix error introduced previously where ZAVG should have been initialized from glob. --- sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index 28d8f3d71..ff880f449 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -258,9 +258,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, allocate (COSCLT(JM),WGTCLT(JM),RCLT(JM),XLAT(JM),DIFFX(JM/2)) allocate (XLON(IM),ORS(NW),oaa(4),ola(4),GLAT(JMN)) - allocate (WORK1(IM,JM),WORK2(IM,JM),WORK3(IM,JM),WORK4(IM,JM)) - allocate (WORK5(IM,JM),WORK6(IM,JM)) - allocate (ZAVG(IMN,JMN)) allocate (ZSLM(IMN,JMN)) allocate (UMD(IMN,JMN)) @@ -390,6 +387,8 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, C ! --- ZSLM initialize with all land 1, ocean 0 ZSLM=1 +! --- ZAVG initialize from glob + ZAVG=glob SELECTCASE(MSKSRC) C---- 30" sea land mask. 0 are water (lake or ocean) @@ -412,7 +411,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, UMD(it,J) = i3save enddo enddo -! --- UMD slmsk with 30" lakes and set ZAVG from glob +! --- UMD slmsk with 30" lakes do j=1,jmn do i=1,imn if ( UMD(i,j) .eq. 0 ) ZSLM(i,j) = 0 @@ -430,7 +429,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, oldslm = ZSLM(IMN,j) do i=1,imn i1 = i + 1 -! --- slmsk with 10' lakes and set ZAVG from 30" glob +! --- slmsk with 10' lakes if ( glob(i,j) .eq. -9999 ) then ZSLM(i,j) = 0 kount = kount + 1 @@ -453,7 +452,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, enddo ! --- CASE(-1) - print *,' ***** set ZAVG and slm from 30" glob, MSKSRC=',MSKSRC + print *,' ***** set slm from 30" glob, MSKSRC=',MSKSRC kount = 0 kount2 = 0 do j=1,jmn @@ -924,6 +923,8 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, C allocate (IWORK(IM,JM,4)) allocate (OA(IM,JM,4),OL(IM,JM,4),HPRIME(IM,JM,14)) + allocate (WORK1(IM,JM),WORK2(IM,JM),WORK3(IM,JM),WORK4(IM,JM)) + allocate (WORK5(IM,JM),WORK6(IM,JM)) call minmxj(IM,JM,ORO,' ORO') print*, "inputorog=", trim(INPUTOROG) @@ -1060,6 +1061,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! Deallocate 2d vars deallocate (ZSLM,ZAVG) deallocate (dx,dy) + deallocate (WORK2,WORK3,WORK4,WORK5,WORK6) ! Deallocate 3d vars deallocate(IWORK) @@ -1394,6 +1396,9 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ORS=0. ORF=ORO ENDIF + + deallocate (WORK1) + call mnmxja(IM,JM,ELVMAX,itest,jtest,' ELVMAX') print *,' ELVMAX(',itest,jtest,')=',ELVMAX(itest,jtest) print *,' after spectral filter is applied' From 9a40e31fdaa7178af75fa516e9620b1bca01cb46 Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Tue, 29 Jun 2021 09:42:45 -0600 Subject: [PATCH 13/17] Some comment fixes --- sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index ff880f449..410641513 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -267,7 +267,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! DEGRAD = 180./PI SPECTR = NM .GT. 0 ! if NM <=0 grid is assumed lat/lon - FILTER = .TRUE. ! Spectr Filter defaults true and set by NF1 + FILTER = .TRUE. ! Spectr Filter defaults true and set by NF1 & NF0 ! MSKSRC = 0 ! MSKSRC=0 navy 10 lake msk, 1 UMD 30, -1 no lakes MSKSRC = 1 ! MSKSRC=0 navy 10 lake msk, 1 UMD 30, -1 no lakes REVLAT = BLAT .LT. 0 ! Reverse latitude/longitude for output @@ -467,7 +467,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, enddo END SELECT -! Deallocate 2dvars deallocate (ZSLMX,UMD,glob) ! --- ! --- Fixing an error in the topo 30" data set at pole (-9999). @@ -909,7 +908,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, CALL MAKEPC(ZAVG,ZSLM,THETA,GAMMA,SIGMA,GLAT, 1 IST,IEN,JST,JEN,IM,JM,IMN,JMN,XLAT,numi) endif - + call minmxj(IM,JM,THETA,' THETA') call minmxj(IM,JM,GAMMA,' GAMMA') call minmxj(IM,JM,SIGMA,' SIGMA') From bbc6a03fa4a4b269805f6be96d8766fd85b56c21 Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Thu, 1 Jul 2021 23:45:46 +0000 Subject: [PATCH 14/17] Organize variables by dimensionality --- sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index 410641513..d372077a8 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -209,10 +209,11 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, integer, allocatable :: IST(:,:),IEN(:,:),ZSLMX(:,:) integer, allocatable :: ZAVG(:,:),ZSLM(:,:) - integer, allocatable :: IWORK(:,:,:) integer(1), allocatable :: UMD(:,:) integer(2), allocatable :: glob(:,:) + integer, allocatable :: IWORK(:,:,:) + real :: DEGRAD,maxlat, minlat,timef,tbeg,tend,tbeg1 real :: dlat,PHI,DELXN,RS,RN,slma,oroa,vara,var4a,xn,XS,FFF,WWW real :: sumdif,avedif,alon,alat @@ -228,14 +229,14 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, real, allocatable :: VAR4(:,:),SLMI(:,:) real, allocatable :: WORK1(:,:),WORK2(:,:),WORK3(:,:),WORK4(:,:) real, allocatable :: WORK5(:,:),WORK6(:,:) - - real, allocatable :: OA(:,:,:),OL(:,:,:),HPRIME(:,:,:) - real, allocatable :: tmpvar(:,:) - real, allocatable :: oa_in(:,:,:), ol_in(:,:,:) real, allocatable :: slm_in(:,:), lon_in(:,:), lat_in(:,:) real(4), allocatable:: GICE(:,:),OCLSM(:,:) + real, allocatable :: OA(:,:,:),OL(:,:,:),HPRIME(:,:,:) + real, allocatable :: oa_in(:,:,:), ol_in(:,:,:) + + complex :: ffj(im/2+1) logical :: LATLONGRID,grid_from_file,output_binary,fexist,opened From 1a3df6df3304d05fdfb47df638f7e23ada548b6e Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Mon, 12 Jul 2021 18:01:46 +0000 Subject: [PATCH 15/17] Remove unused variables from modified subroutines --- .../orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 22 +++---------------- 1 file changed, 3 insertions(+), 19 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index d372077a8..00f96ff86 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -79,8 +79,6 @@ integer fsize, ncid, error, id_dim, nx, ny character(len=256) :: OUTGRID = "none" character(len=256) :: INPUTOROG = "none" - logical :: do_oa = .true. ! create oa and ol data. - logical :: grid_from_file = .true. integer :: MTNRES,IM,JM,NM,NR,NF0,NF1,EFAC,BLAT,NW fsize=65536 READ(5,*) MTNRES,IM,JM,NM,NR,NF0,NF1,EFAC,BLAT @@ -215,8 +213,8 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, integer, allocatable :: IWORK(:,:,:) real :: DEGRAD,maxlat, minlat,timef,tbeg,tend,tbeg1 - real :: dlat,PHI,DELXN,RS,RN,slma,oroa,vara,var4a,xn,XS,FFF,WWW - real :: sumdif,avedif,alon,alat + real :: PHI,DELXN,RS,RN,slma,oroa,vara,var4a,xn,XS,FFF,WWW + real :: sumdif,avedif real, allocatable :: COSCLT(:),WGTCLT(:),RCLT(:),XLAT(:),DIFFX(:) real, allocatable :: XLON(:),ORS(:),oaa(:),ola(:),GLAT(:) @@ -239,7 +237,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, complex :: ffj(im/2+1) - logical :: LATLONGRID,grid_from_file,output_binary,fexist,opened + logical :: grid_from_file,output_binary,fexist,opened logical :: SPECTR, REVLAT, FILTER logical :: is_south_pole(IM,JM), is_north_pole(IM,JM) @@ -578,20 +576,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ZSLM(i,j) = 1 endif endif -!jaa ALON = float(i-1) * 360./float(IMN) -!jaa ALAT = glat(j) -! if( ZAVG(i,j) .ne. zsave1 .and. i .lt. 3 ) -! & print *,' antarctica change to ZAVG(i=',i,'j=',j,')=', -! & ZAVG(i,j),ZSLM(i,j),' from originally:',zsave1,zsave2 -! &write(6,151)i,j,ZAVG(i,j),ZSLM(i,j),zsave1,zsave2,ALAT,ALON -! 151 format(1x,'antarctica ZAVG(i=',i3,' j=',i3,')=',i5,i3, -! &' orig:',i5,i3,' Lat=',f8.3,f9.3,'E') -!jaa if( ZAVG(i,j) .ne. zsave1 ) then -!jaa if ( i .le. 1201 .and. i .gt. 1200 )then -!jaa write(6,152)i,j,ZAVG(i,j),ZSLM(i,j),zsave1,zsave2,ALAT,ALON, -!jaa & GICE(i,j) -!jaa endif -!jaa endif 152 format(1x,' ZAVG(i=',i4,' j=',i4,')=',i5,i3, &' orig:',i5,i4,' Lat=',f7.3,f8.2,'E',' GICE=',f8.1) enddo From 8a1d064e542d79e2ee6e1fa21de7a8e58fad629e Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Mon, 12 Jul 2021 19:32:08 +0000 Subject: [PATCH 16/17] Explicitly deallocate all allocated variables --- sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index 00f96ff86..84ebc7d76 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -842,7 +842,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, ! call netcdf_err(error, 'inquire data of dy from file ' ! & //trim(OUTGRID) ) ! dy(1:IM+1,1:JM) = tmpvar(1:nx+1:2,2:ny:2) -! deallocate(tmpvar) + deallocate(tmpvar) endif tend=timef() write(6,*)' Timer 1 time= ',tend-tbeg @@ -1042,7 +1042,11 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, 3 IST,IEN,JST,JEN,IM,JM,IMN,JMN,XLAT,numi) endif +! Deallocate 1d vars + deallocate(IST,IEN) + ! Deallocate 2d vars + deallocate(IST,IEN) deallocate (ZSLM,ZAVG) deallocate (dx,dy) deallocate (WORK2,WORK3,WORK4,WORK5,WORK6) @@ -1578,6 +1582,7 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, deallocate(COSCLT,WGTCLT,RCLT,XLAT,DIFFX,XLON,ORS,oaa,ola,GLAT) ! Deallocate 2d vars + deallocate (OCLSM) deallocate (GEOLON,GEOLON_C,GEOLAT,GEOLAT_C) deallocate (SLM,ORO,VAR,ORF,land_frac) deallocate (THETA,GAMMA,SIGMA,ELVMAX) From daf07443e74c7993188be84a404806a753b9f577 Mon Sep 17 00:00:00 2001 From: "Michael Kavulich, Jr" Date: Fri, 16 Jul 2021 16:06:46 +0000 Subject: [PATCH 17/17] Accidentally deallocated twice --- sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f | 3 --- 1 file changed, 3 deletions(-) diff --git a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f index 84ebc7d76..88d397303 100644 --- a/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f +++ b/sorc/orog_mask_tools.fd/orog.fd/mtnlm7_oclsm.f @@ -1042,9 +1042,6 @@ SUBROUTINE TERSUB(IMN,JMN,IM,JM,NM,NR,NF0,NF1,NW,EFAC,BLAT, 3 IST,IEN,JST,JEN,IM,JM,IMN,JMN,XLAT,numi) endif -! Deallocate 1d vars - deallocate(IST,IEN) - ! Deallocate 2d vars deallocate(IST,IEN) deallocate (ZSLM,ZAVG)