Update r-dist for SLES15

CHANGELOG.md

@@ -14,19 +14,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 ### Fixed
 
 - Fixed gpy module in `idcheck.pl`
+- fix r_dist for SLES-15
 
 ### Removed
 
 ### Deprecated
 
-
 ## [2.1.4] - 2025-08-29
 
 ### Changed
 
 - Updated `esma_mpirun` for `openmpi` to run with `-map-by node -bind-to core` which is a good default.
 
-
 ## [2.1.3] - 2025-07-07
 
 ### Fixed

GMAO_etc/r_dist

@@ -401,8 +401,8 @@ return $put_rc;
 sub resolve {
 
     my ( $LOCALROOT,$REMOTEROOT,$expno,$yyyy,$yy,$mm,$dd,$hh,$file ) = @_;
-    $file =~ s/\${REMOTEROOT}/$REMOTEROOT/g;
-    $file =~ s/\${LOCALROOT}/$LOCALROOT/g;
+    $file =~ s/\$\{REMOTEROOT}/$REMOTEROOT/g;
+    $file =~ s/\$\{LOCALROOT}/$LOCALROOT/g;
     $file =~ s/%y4/$yyyy/g;
     $file =~ s/%y2/$yy/g;
     $file =~ s/%m2/$mm/g;

GMAO_hermes/dyn2dyn.f90

@@ -14,6 +14,7 @@ program dyn2dyn
       use m_dyn
       use m_set_eta, only : set_ncep72,unset_ncep72
       use m_dyn2dyn, only : dyn2dyn_do
+      use m_topo_remap, only: dyn_topo_remap
 
       use m_StrTemplate        ! grads style templates
 
@@ -75,6 +76,7 @@ program dyn2dyn
 !     ------
       character(len=255) msg
       character(len=255), pointer :: xtrnames(:)
+      character(len=255) phfile
       integer, parameter :: READ_ONLY = 1
       integer fid, nvars, ngatts
       integer ier, ifile
@@ -97,7 +99,7 @@ program dyn2dyn
                                 fakedate, nymdf, nhmsf, &
                                 dophys, expid, RCfile, verbose, oldana, force, &
                                 vectype, dgrid, ncep72, ncf, pncf, indxlevs, &
-                                xtrnames )
+                                xtrnames, phfile )
 
 
 !  Loop over input eta files
@@ -155,6 +157,12 @@ program dyn2dyn
          end if
          if(ncep72) call set_ncep72
 
+!        If topographic remap requested ...
+!        ----------------------------------
+         if ( trim(phfile) /= "NONE" ) then
+            call dyn_topo_remap(trim(phfile), w_e, vectype, ier)
+         endif
+
 !        Perform interpolation
 !        ---------------------
          if ( trim(RCfile)=='NONE' ) then
@@ -211,7 +219,7 @@ subroutine Init_ ( mfiles, etafiles, nfiles, dynfile, lwifile, &
                          fakedate, nymdf, nhmsf,                     &
                          dophys, expid, RCfile, verbose, oldana, force, &
                          vectype, dgrid, ncep72, ncf, pncf, indxlevs, &
-                         xtrnames )
+                         xtrnames, phfile )
 
       implicit NONE
 
@@ -245,6 +253,7 @@ subroutine Init_ ( mfiles, etafiles, nfiles, dynfile, lwifile, &
       logical,       intent(out) :: pncf    ! non-complaint dyn-perturbation file knob
       logical,       intent(out) :: indxlevs! index levels (in place of pressure levs)
       character(len=*), pointer  :: xtrnames(:)
+      character(len=*) :: phfile
 
 !
 ! !REVISION HISTORY:
@@ -319,6 +328,7 @@ subroutine Init_ ( mfiles, etafiles, nfiles, dynfile, lwifile, &
       trnames = 'NONE'
       im_usr = -1
       jm_usr = -1
+      phfile = 'NONE'
 
 !     Parse command line
 !     ------------------
@@ -466,6 +476,10 @@ subroutine Init_ ( mfiles, etafiles, nfiles, dynfile, lwifile, &
                ncf = .true.
            case ('-pncf')
                pncf = .true.
+           case ("-phfile")
+             if ( iarg+1 .gt. argc ) call usage()
+             iarg = iarg + 1
+             call GetArg ( iarg, phfile )
            case ('-prec')
             if ( iarg+1 .gt. argc ) call usage()
             iarg = iarg + 1
@@ -604,6 +618,7 @@ subroutine usage()
       print *, '-ncf          non-compliant dyn-vector (see NOTES)'
       print *, '-pncf         non-compliant dyn-vector perturbation (see NOTES)'
       print *, '-tracers N,M  read/write extra tracers of name N and M from ori file to new'
+      print *, '-phfile FNAME when alternative dyn-vec file provided, will perform topo-remap'
       print *
       print *, ' NOTES:'
       print *, '   1)  For the time being, in order to do horizontal'

GMAO_hermes/m_topo_remap.F90

@@ -13,6 +13,7 @@ module m_topo_remap
 
 use m_dyn
 use shared_topo_remap, only : dyn_topo_remap, gmap
+use m_die, only: die
 implicit none
 private
 
@@ -22,6 +23,7 @@ module m_topo_remap
 
 !
 interface dyn_topo_remap
+  module procedure dyn_topo_remap0_
   module procedure dyn_topo_remap_
 end interface
 interface dyn_real_eta
@@ -49,6 +51,34 @@ module m_topo_remap
 !EOP
 !-------------------------------------------------------------------------
 CONTAINS
+      subroutine dyn_topo_remap0_(fname, w_f, dyntype, rc)
+      implicit none
+      character(len=*), intent(in) :: fname 
+      type(dyn_vect) w_f
+      integer, intent(in)  :: dyntype
+      integer, intent(out) :: rc
+
+      character(len=*), parameter :: myname_ = myname//'*dyn_topo_remap0_'
+      integer nymd, nhms
+      type(dyn_vect) w_p
+
+      ! assume file w/ alternative phis is dyn-vect (can generalize later)
+      call dyn_get ( trim(fname), nymd, nhms, w_p, rc, timidx=1, vectype=dyntype )
+      if (rc/=0) then
+        call die(myname_,'failed getting topo to remap to' )
+      else
+        print *, "read topo to remap to from: ", trim(fname)
+      endif
+
+      if ( w_p%grid%im == w_f%grid%im .and. w_p%grid%jm == w_f%grid%jm ) then
+        call dyn_topo_remap ( w_f, w_p%phis, dyntype, info=rc )
+      else
+        call die(myname_,'inconsistent dimensions' )
+      endif
+      print *, "Topo remap done"
+
+      end subroutine dyn_topo_remap0_
+
       subroutine dyn_topo_remap_( w_f,phis_new, dyntype, info )
       implicit none
       integer,intent(in) :: dyntype

GMAO_transf/CMakeLists.txt

@@ -96,11 +96,11 @@ set (srcs
 set (CMAKE_Fortran_FLAGS_RELEASE "-O3 ${common_Fortran_flags} ${ALIGNCOM} ${MISMATCH}")
 set (CMAKE_Fortran_FLAGS_DEBUG   "${GEOS_Fortran_FLAGS_DEBUG}")
 
-ecbuild_add_executable(TARGET dyn_divo.x SOURCES dyn_divo.F90 LIBS ${this} GMAO_mpeu GMAO_hermes NCEP_w3_r8i4 NCEP_sp_r8i4 FFLAGS "${FREAL8}")
-ecbuild_add_executable(TARGET ec2fv.x SOURCES ec2fv.F90 LIBS ${this} GMAO_mpeu GMAO_hermes NCEP_w3_r8i4 NCEP_sp_r8i4 FFLAGS "${FREAL8}")
-ecbuild_add_executable(TARGET fv2ss.x SOURCES fv2ss.f90 LIBS ${this} GMAO_mpeu GMAO_hermes NCEP_w3_r8i4 NCEP_sp_r8i4 FFLAGS "${FREAL8}")
-ecbuild_add_executable(TARGET g4tog5.x SOURCES g4tog5.f90 LIBS ${this} GMAO_mpeu GMAO_hermes NCEP_w3_r8i4 NCEP_sp_r8i4 FFLAGS "${FREAL8}")
-ecbuild_add_executable(TARGET ss2fv.x SOURCES ss2fv.f90 LIBS ${this} GMAO_mpeu GMAO_hermes NCEP_w3_r8i4 NCEP_sp_r8i4 FFLAGS "${FREAL8}")
+ecbuild_add_executable(TARGET dyn_divo.x SOURCES dyn_divo.F90 LIBS ${this} GMAO_eu GMAO_hermes NCEP_w3_r8i4 NCEP_sp_r8i4 FFLAGS "${FREAL8}")
+ecbuild_add_executable(TARGET ec2fv.x SOURCES ec2fv.F90 LIBS ${this} GMAO_eu GMAO_hermes NCEP_w3_r8i4 NCEP_sp_r8i4 FFLAGS "${FREAL8}")
+ecbuild_add_executable(TARGET fv2ss.x SOURCES fv2ss.f90 LIBS ${this} GMAO_eu GMAO_hermes NCEP_w3_r8i4 NCEP_sp_r8i4 FFLAGS "${FREAL8}")
+ecbuild_add_executable(TARGET g4tog5.x SOURCES g4tog5.f90 LIBS ${this} GMAO_eu GMAO_hermes NCEP_w3_r8i4 NCEP_sp_r8i4 FFLAGS "${FREAL8}")
+ecbuild_add_executable(TARGET ss2fv.x SOURCES ss2fv.f90 LIBS ${this} GMAO_eu GMAO_hermes NCEP_w3_r8i4 NCEP_sp_r8i4 FFLAGS "${FREAL8}")
 
 install (PROGRAMS ec2fv.csh DESTINATION bin)
 

GMAO_transf/dyn_divo.F90

@@ -1,5 +1,4 @@
    program dyn_vordiv
-!  must run as mpirun -np 1
    use m_ggGradientSP,only : ggGradientSP
    use m_ggGradientSP,only : ggGradientSP_init,clean
    use m_ggGradientSP,only : ggDivo
@@ -19,7 +18,11 @@ program dyn_vordiv
    use m_dyn, only: dyn_stat
    use m_dyn, only: dyn_flip
 
-   use m_die, only: die
+   use m_mpif90,only : MP_init
+   use m_mpif90,only : MP_finalize
+   use m_mpif90,only : MP_comm_rank
+
+   use m_die, only: MP_die,die
 
    implicit none
 
@@ -48,48 +51,64 @@ program dyn_vordiv
    integer, parameter :: mfiles=2
    integer iargc,nfiles
    integer iarg,argc,nymd,nhms,freq
-   integer im,jm,km,jcap
+   integer im,jm,km,lm,jcap
    integer i,ierr
 
    logical sfvp
    logical overwrite
+   logical getrh
+   logical pncf
 
+! MPI Initialization
+! ------------------
+   call MP_init(ierr)
+        if(ierr/=0) call MP_die(myname,'MP_init()',ierr)
+
    argc = iargc()
    if ( argc < 1 ) then
         call usage_()
    end if
 
+   iarg=0
    nfiles=0
    overwrite = .true.
    sfvp=.false.
+   getrh = .false.
+   pncf = .false.
    do i = 1, 32767
       iarg = iarg + 1
       if ( iarg .gt. argc ) exit
       call GetArg ( iarg, argv )
       select case (argv)
-          case ("-noverw")
-            overwrite = .false.
-      case ("-jcap")
+        case ("-noverw")
+          overwrite = .false.
+        case ("-getrh")
+          getrh = .true.
+        case ("-pncf")
+          pncf = .true.
+        case ("-jcap")
           if ( iarg+1 .gt. argc ) call usage_()
           iarg = iarg + 1
           call GetArg ( iarg, argv )
           read(argv,*) jcap
           sfvp=.true.
-      case default
+        case default
           nfiles = nfiles + 1
           if ( nfiles .gt. mfiles ) call die(myname,'too many eta files')
           if (nfiles == 1) ifile = trim(argv)
           if (nfiles == 2) ofile = trim(argv)
       end select
-
-
    enddo
 
    print*, "Reading file: ", trim(ifile)
-   allocate(xtrnames(2))
-   xtrnames=(/'rh ','mrh'/)
-   call dyn_get ( trim(ifile), nymd, nhms, dyn, ierr, timidx=1, freq=freq, vectype=5, xtrnames=xtrnames )
-   deallocate(xtrnames)
+   if (getrh) then
+     allocate(xtrnames(2))
+     xtrnames=(/'rh ','mrh'/)
+     call dyn_get ( trim(ifile), nymd, nhms, dyn, ierr, timidx=1, freq=freq, vectype=5, pncf=pncf, xtrnames=xtrnames )
+     deallocate(xtrnames)
+   else
+     call dyn_get ( trim(ifile), nymd, nhms, dyn, ierr, timidx=1, freq=freq, vectype=5, pncf=pncf )
+   endif
 
    im = dyn%grid%im
    jm = dyn%grid%jm
@@ -165,6 +184,11 @@ program dyn_vordiv
    deallocate( sf, vp, stat=ierr)
    deallocate(div,vor, stat=ierr)
 
+! finalize
+! --------
+  call MP_finalize(ierr)
+        if(ierr/=0) call MP_die(myname,'MP_finalized()',ierr)
+
 contains
    subroutine get_latlon_
       implicit none
@@ -217,6 +241,8 @@ subroutine usage_
         print *, " Options: "
         print *, "  -jcap  JCAP  - set truncation (triggers calc vp/sf)"
         print *, "  -noverw      - do not overwrite u/v w/ vp/sf"
+        print *, "  -getrh       - in case input has rh/mrh fields"
+        print *, "  -pncf        - in case input in non-compliant perturbation"
         print *
         stop
    end subroutine usage_