Create stub include file, remove unused imports of JPRB in trans/inte…

…rnal, introduce JPRC => JPRB type to annotate number constants in ./internal. This is because nvhpc preprocessor does not allow _JPRB macro.
ecmwf-ifs · Nov 20, 2023 · a579bae · a579bae
1 parent 8e43d94
commit a579bae
Show file tree

Hide file tree

Showing 120 changed files with 248 additions and 103 deletions.
diff --git a/src/trans/include/ectrans/renames.inc b/src/trans/include/ectrans/renames.inc
diff --git a/src/trans/internal/abort_trans_mod.F90 b/src/trans/internal/abort_trans_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE ABORT_TRANS_MOD
 CONTAINS
 SUBROUTINE ABORT_TRANS(CDTEXT)

diff --git a/src/trans/internal/asre1_mod.F90 b/src/trans/internal/asre1_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE ASRE1_MOD
 CONTAINS
 SUBROUTINE ASRE1(KM,KMLOC,KF_OUT_LT,PAOA1,PSOA1)

diff --git a/src/trans/internal/asre1ad_mod.F90 b/src/trans/internal/asre1ad_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE ASRE1AD_MOD
 CONTAINS
 SUBROUTINE ASRE1AD(KM,KMLOC,KF_OUT_LT,PAOA1,PSOA1)

diff --git a/src/trans/internal/asre1b_mod.F90 b/src/trans/internal/asre1b_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE ASRE1B_MOD
 CONTAINS
 SUBROUTINE ASRE1B(KFIELD,KM,KMLOC,PAOA,PSOA)

diff --git a/src/trans/internal/asre1bad_mod.F90 b/src/trans/internal/asre1bad_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE ASRE1BAD_MOD
 CONTAINS
 SUBROUTINE ASRE1BAD(KFIELD,KM,KMLOC,PAOA,PSOA)

diff --git a/src/trans/internal/cdmap_mod.F90 b/src/trans/internal/cdmap_mod.F90
@@ -8,12 +8,14 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE CDMAP_MOD
 CONTAINS
 SUBROUTINE CDMAP(KM,KMLOC,KSL,KSLO,PEPSNM, KDIR, KDGNH, KDGNHD,&
 & KFIELDS, PCOEFA, PCOEFS)
 
 USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE PARKIND1  ,ONLY : JPRC => JPRB
 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK, JPHOOK
 USE TPM_FLT
 USE TPM_GEOMETRY
@@ -105,10 +107,10 @@ SUBROUTINE CDMAP(KM,KMLOC,KSL,KSLO,PEPSNM, KDIR, KDGNH, KDGNHD,&
   ALLOCATE(ZALL1(KFIELDS, 2*KDGNHD))
   ALLOCATE(ZQX(KFIELDS, 2*KDGNH))
   ALLOCATE(ZQY(KFIELDS, 2*KDGNH))
-  ZQX(:,1:KSL) = 0._JPRB
-  ZQX(:,IEND:2*KDGNH) = 0._JPRB
-  ZQY(:,1:KSL) = 0._JPRB
-  ZQY(:,IEND:2*KDGNH) = 0._JPRB
+  ZQX(:,1:KSL) = 0._JPRC
+  ZQX(:,IEND:2*KDGNH) = 0._JPRC
+  ZQY(:,1:KSL) = 0._JPRC
+  ZQY(:,IEND:2*KDGNH) = 0._JPRC
   DO JGL=KSL, IEND
     ZQX(1:KFIELDS,JGL)=S%FA(KMLOC)%RPNMWI(JGL-KSL+1,1)*PCOEFA(1:KFIELDS,JGL)
     ZQY(1:KFIELDS,JGL)=S%FA(KMLOC)%RPNMWI(JGL-KSL+1,2)*PCOEFA(1:KFIELDS,JGL)
@@ -150,8 +152,8 @@ SUBROUTINE CDMAP(KM,KMLOC,KSL,KSLO,PEPSNM, KDIR, KDGNH, KDGNHD,&
   ENDDO
 
   ALLOCATE( ZQX( KFIELDS, 2*KDGNHD))
-  ZQX(:,1:KSLO) = 0._JPRB
-  ZQX(:,IENDO:2*KDGNHD) = 0._JPRB
+  ZQX(:,1:KSLO) = 0._JPRC
+  ZQX(:,IENDO:2*KDGNHD) = 0._JPRC
   DO JGL=KSLO, KDGNHD
     IGLS = 2*KDGNHD+1-JGL
     DO JF=1,KFIELDS

diff --git a/src/trans/internal/cpledn_mod.F90 b/src/trans/internal/cpledn_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE CPLEDN_MOD
 CONTAINS
 SUBROUTINE CPLEDN(KN,KODD,PFN,PX,KFLAG,PW,PXN,PXMOD)

diff --git a/src/trans/internal/dealloc_resol_mod.F90 b/src/trans/internal/dealloc_resol_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE DEALLOC_RESOL_MOD
 CONTAINS
 SUBROUTINE DEALLOC_RESOL(KRESOL)
@@ -41,7 +42,7 @@ SUBROUTINE DEALLOC_RESOL(KRESOL)
 
 !     ------------------------------------------------------------------
 
-USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE PARKIND1  ,ONLY : JPIM
 
 USE TPM_DIM         ,ONLY : R
 USE TPM_GEN         ,ONLY : LENABLED, NOUT,NDEF_RESOL

diff --git a/src/trans/internal/dir_trans_ctl_mod.F90 b/src/trans/internal/dir_trans_ctl_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE DIR_TRANS_CTL_MOD
 CONTAINS
 SUBROUTINE DIR_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_UV,KF_SCALARS,&

diff --git a/src/trans/internal/dir_trans_ctlad_mod.F90 b/src/trans/internal/dir_trans_ctlad_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE DIR_TRANS_CTLAD_MOD
 CONTAINS
 SUBROUTINE DIR_TRANS_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_UV,KF_SCALARS,&

diff --git a/src/trans/internal/dist_grid_32_ctl_mod.F90 b/src/trans/internal/dist_grid_32_ctl_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE DIST_GRID_32_CTL_MOD
 CONTAINS
 SUBROUTINE DIST_GRID_32_CTL(PGPG,KFDISTG,KPROMA,KFROM,PGP)
@@ -43,7 +44,7 @@ SUBROUTINE DIST_GRID_32_CTL(PGPG,KFDISTG,KPROMA,KFROM,PGP)
 
 !     ------------------------------------------------------------------
 
-USE PARKIND1  ,ONLY : JPIM     ,JPRB  ,JPRM
+USE PARKIND1  ,ONLY : JPIM     ,JPRM
 USE MPL_MODULE
 
 USE TPM_DISTR

diff --git a/src/trans/internal/dist_grid_ctl_mod.F90 b/src/trans/internal/dist_grid_ctl_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE DIST_GRID_CTL_MOD
 CONTAINS
 SUBROUTINE DIST_GRID_CTL(PGPG,KFDISTG,KPROMA,KFROM,PGP,KSORT)

diff --git a/src/trans/internal/dist_spec_control_mod.F90 b/src/trans/internal/dist_spec_control_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE DIST_SPEC_CONTROL_MOD
 CONTAINS
 SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,&
@@ -58,6 +59,7 @@ SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,&
 !     ------------------------------------------------------------------
 
 USE PARKIND1        ,ONLY : JPIM     ,JPRB
+USE PARKIND1        ,ONLY : JPRC => JPRB
 USE MPL_MODULE      ,ONLY : MPL_RECV, MPL_SEND, MPL_WAIT, MPL_WAITANY, JP_NON_BLOCKING_STANDARD
 USE TPM_DISTR       ,ONLY : MTAGDISTSP, MYSETV, MYSETW, NPRCIDS, NPRTRW, MYPROC, NPROC, NPRTRV, D
 USE SET2PE_MOD      ,ONLY : SET2PE
@@ -163,7 +165,7 @@ SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,&
 ! The next lines ensure the large array zbuf is allocated right here and not inside an omp loop below,
 ! where an extra omp synchro might be needed :
 IF (SIZE(ZBUF) > 0) THEN
-  ZBUF(LBOUND(ZBUF,DIM=1),LBOUND(ZBUF,DIM=2),LBOUND(ZBUF,DIM=3))=HUGE(1._JPRB)
+  ZBUF(LBOUND(ZBUF,DIM=1),LBOUND(ZBUF,DIM=2),LBOUND(ZBUF,DIM=3))=HUGE(1._JPRC)
 ENDIF
 
 IF (LDIM1_IS_FLD) THEN

diff --git a/src/trans/internal/ectrans_version_mod.F90.in b/src/trans/internal/ectrans_version_mod.F90.in
@@ -6,7 +6,7 @@
 ! granted to it by virtue of its status as an intergovernmental organisation
 ! nor does it submit to any jurisdiction.
 !
-
+#include "renames.inc"
 MODULE ECTRANS_VERSION_MOD
 
 IMPLICIT NONE

diff --git a/src/trans/internal/eq_regions_mod.F90 b/src/trans/internal/eq_regions_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE eq_regions_mod
 !
 !     Purpose.
@@ -71,6 +72,7 @@ MODULE eq_regions_mod
 !--------------------------------------------------------------------------------
 !
 USE PARKIND1  ,ONLY : JPIM,   JPRB
+USE PARKIND1  ,ONLY : JPRC => JPRB
 
 IMPLICIT NONE
 
@@ -151,7 +153,7 @@ subroutine eq_regions(N)
 real(kind=jprb),allocatable :: r_regions(:)
 real(kind=jprb) :: c_polar
 
-pi=2.0_jprb*asin(1.0_jprb)
+pi=2.0_jprc*asin(1.0_jprc)
 
 n_regions(:)=0
 
@@ -259,14 +261,14 @@ subroutine ideal_region_list(N,c_polar,n_collars,r_regions)
 integer(kind=jpim) :: collar_n
 real(kind=jprb) :: ideal_region_area,ideal_collar_area
 real(kind=jprb) :: a_fitting
-r_regions(:)=0.0_jprb
-r_regions(1) = 1.0_jprb
+r_regions(:)=0.0_jprc
+r_regions(1) = 1.0_jprc
 if( n_collars > 0 )then
   !
   ! Based on n_collars and c_polar, determine a_fitting,
   ! the collar angle such that n_collars collars fit between the polar caps.
   !
-  a_fitting = (pi-2.0_jprb*c_polar)/float(n_collars)
+  a_fitting = (pi-2.0_jprc*c_polar)/float(n_collars)
   ideal_region_area = area_of_ideal_region(N)
   do collar_n=1,n_collars
     ideal_collar_area = area_of_collar(c_polar+(collar_n-1)*a_fitting, &
@@ -289,7 +291,7 @@ function ideal_collar_angle(N) result(ideal)
 IMPLICIT NONE
 integer(kind=jpim),intent(in) :: N
 real(kind=jprb) :: ideal
-ideal = area_of_ideal_region(N)**(0.5_jprb)
+ideal = area_of_ideal_region(N)**(0.5_jprc)
 return
 end function ideal_collar_angle
 
@@ -312,7 +314,7 @@ subroutine round_to_naturals(N,n_collars,r_regions)
 integer(kind=jpim) :: zone_n
 real(kind=jprb) :: discrepancy
 n_regions(1:n_collars+2) = r_regions(:)
-discrepancy = 0.0_jprb
+discrepancy = 0.0_jprc
 do zone_n = 1,n_collars+2
     n_regions(zone_n) = nint(r_regions(zone_n)+discrepancy);
     discrepancy = discrepancy+r_regions(zone_n)-float(n_regions(zone_n));
@@ -330,7 +332,7 @@ function polar_colat(N) result(polar_c)
 real(kind=jprb) :: area
 real(kind=jprb) :: polar_c
 if( N == 1 ) polar_c=pi
-if( N == 2 ) polar_c=pi/2.0_jprb
+if( N == 2 ) polar_c=pi/2.0_jprc
 if( N > 2 )then
   area=area_of_ideal_region(N)
   polar_c=sradius_of_cap(area)
@@ -348,7 +350,7 @@ function area_of_ideal_region(N) result(area)
 integer(kind=jpim),intent(in) :: N
 real(kind=jprb) :: area_of_sphere
 real(kind=jprb) :: area
-area_of_sphere = (2.0_jprb*pi**1.5_jprb/gamma(1.5_jprb))
+area_of_sphere = (2.0_jprc*pi**1.5_jprc/gamma(1.5_jprc))
 area = area_of_sphere/float(N)
 return
 end function area_of_ideal_region
@@ -362,7 +364,7 @@ function sradius_of_cap(area) result(sradius)
 IMPLICIT NONE
 real(kind=jprb),intent(in) :: area
 real(kind=jprb) :: sradius
-sradius = 2.0_jprb*asin(sqrt(area/pi)/2.0_jprb)
+sradius = 2.0_jprc*asin(sqrt(area/pi)/2.0_jprc)
 return
 end function sradius_of_cap
 
@@ -391,7 +393,7 @@ function area_of_cap(s_cap) result(area)
 !
 real(kind=jprb),intent(in) :: s_cap
 real(kind=jprb) area
-area = 4.0_jprb*pi * sin(s_cap/2.0_jprb)**2
+area = 4.0_jprc*pi * sin(s_cap/2.0_jprc)**2
 return
 end function area_of_cap
 
@@ -405,21 +407,21 @@ function gamma(x) result(gamma_res)
 real(kind=jprb) :: w,y
 integer(kind=jpim) :: k,n
 parameter (&
-& p0 =   0.999999999999999990e+00_jprb,&
-& p1 =  -0.422784335098466784e+00_jprb,&
-& p2 =  -0.233093736421782878e+00_jprb,&
-& p3 =   0.191091101387638410e+00_jprb,&
-& p4 =  -0.024552490005641278e+00_jprb,&
-& p5 =  -0.017645244547851414e+00_jprb,&
-& p6 =   0.008023273027855346e+00_jprb)
+& p0 =   0.999999999999999990e+00_jprc,&
+& p1 =  -0.422784335098466784e+00_jprc,&
+& p2 =  -0.233093736421782878e+00_jprc,&
+& p3 =   0.191091101387638410e+00_jprc,&
+& p4 =  -0.024552490005641278e+00_jprc,&
+& p5 =  -0.017645244547851414e+00_jprc,&
+& p6 =   0.008023273027855346e+00_jprc)
 parameter (&
-& p7 =  -0.000804329819255744e+00_jprb,&
-& p8 =  -0.000360837876648255e+00_jprb,&
-& p9 =   0.000145596568617526e+00_jprb,&
-& p10 = -0.000017545539395205e+00_jprb,&
-& p11 = -0.000002591225267689e+00_jprb,&
-& p12 =  0.000001337767384067e+00_jprb,&
-& p13 = -0.000000199542863674e+00_jprb)
+& p7 =  -0.000804329819255744e+00_jprc,&
+& p8 =  -0.000360837876648255e+00_jprc,&
+& p9 =   0.000145596568617526e+00_jprc,&
+& p10 = -0.000017545539395205e+00_jprc,&
+& p11 = -0.000002591225267689e+00_jprc,&
+& p12 =  0.000001337767384067e+00_jprc,&
+& p13 = -0.000000199542863674e+00_jprc)
 n = nint(x - 2)
 w = x - (n + 2)
 y = ((((((((((((p13 * w + p12) * w + p11) * w + p10) *&

diff --git a/src/trans/internal/field_split_mod.F90 b/src/trans/internal/field_split_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE FIELD_SPLIT_MOD
 CONTAINS
 SUBROUTINE FIELD_SPLIT(KBLK,KF_GP,KKF_UV_G,KVSETUV,KVSETSC,&
@@ -58,7 +59,7 @@ SUBROUTINE FIELD_SPLIT(KBLK,KF_GP,KKF_UV_G,KVSETUV,KVSETSC,&
 !        Original : 01-01-03
 
 !     ------------------------------------------------------------------
-USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE PARKIND1  ,ONLY : JPIM
 
 USE TPM_GEN         ,ONLY : NPROMATR
 !USE TPM_TRANS

diff --git a/src/trans/internal/fourier_in_mod.F90 b/src/trans/internal/fourier_in_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE FOURIER_IN_MOD
 CONTAINS
 SUBROUTINE FOURIER_IN(PREEL,KFIELDS,KGL)

diff --git a/src/trans/internal/fourier_inad_mod.F90 b/src/trans/internal/fourier_inad_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE FOURIER_INAD_MOD
 CONTAINS
 SUBROUTINE FOURIER_INAD(PREEL,KFIELDS,KGL)

diff --git a/src/trans/internal/fourier_out_mod.F90 b/src/trans/internal/fourier_out_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE FOURIER_OUT_MOD
 CONTAINS
 SUBROUTINE FOURIER_OUT(PREEL,KFIELDS,KGL)

diff --git a/src/trans/internal/fourier_outad_mod.F90 b/src/trans/internal/fourier_outad_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE FOURIER_OUTAD_MOD
 CONTAINS
 SUBROUTINE FOURIER_OUTAD(PREEL,KFIELDS,KGL)

diff --git a/src/trans/internal/fsc_mod.F90 b/src/trans/internal/fsc_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE FSC_MOD
 CONTAINS
 SUBROUTINE FSC(KGL,KF_UV,KF_SCALARS,KF_SCDERS,&
@@ -47,6 +48,7 @@ SUBROUTINE FSC(KGL,KF_UV,KF_SCALARS,KF_SCDERS,&
 !     ------------------------------------------------------------------
 
 USE PARKIND1  ,ONLY : JPIM     ,JPRB
+USE PARKIND1  ,ONLY : JPRC =>   JPRB
 
 USE TPM_TRANS       ,ONLY : LUVDER, LATLON
 USE TPM_DISTR       ,ONLY : D, MYSETW
@@ -79,8 +81,8 @@ SUBROUTINE FSC(KGL,KF_UV,KF_SCALARS,KF_SCDERS,&
 ZACHTE2  = F%RACTHE(IGLG)
 
 IF( LATLON.AND.S%LDLL ) THEN
-  ZPI = 2.0_JPRB*ASIN(1.0_JPRB)
-  ZACHTE2 = 1._JPRB
+  ZPI = 2.0_JPRC*ASIN(1.0_JPRC)
+  ZACHTE2 = 1._JPRC
   ZACHTE  = F%RACTHE2(IGLG)
 
   ! apply shift for (even) lat-lon output grid

diff --git a/src/trans/internal/fscad_mod.F90 b/src/trans/internal/fscad_mod.F90
@@ -8,6 +8,7 @@
 ! nor does it submit to any jurisdiction.
 !
 
+#include "renames.inc"
 MODULE FSCAD_MOD
 CONTAINS
 SUBROUTINE FSCAD(KGL,KF_UV,KF_SCALARS,KF_SCDERS,&