Merge pull request #193 from ecmwf-ifs/feature/error_handling

Improve error handling for GPU code path unimplemented features

src/trans/gpu/external/setup_trans.F90

@@ -283,6 +283,24 @@ SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,&
 R%NNOEXTZL=0
 R%NNOEXTZG=0
 
+
+IF(PRESENT(LDSPSETUPONLY)) THEN
+  LLSPSETUPONLY=LDSPSETUPONLY
+! <<<<<<<<<<< EXTRA TO WORKAROUND NOT YET IMPLEMENTED FEATURE
+  IF (LLSPSETUPONLY) THEN
+    WRITE(NOUT,'(A)') "DEVELOPER WARNING: LDSPSETUPONLY IS NOT YET IMPLEMENTED CORRECTLY WITH GPU BACKEND. IGNORING IT FOR NOW"
+    LLSPSETUPONLY = .FALSE.
+    R%NDGL = NPROC
+    ! Make even and positive
+    IF (MOD(R%NDGL,2) /= 0) THEN
+      R%NDGL = NPROC+1
+    ENDIF
+    R%NDGL = MAX(2,R%NDGL)
+  ENDIF
+! >>>>>>>>>>>>>
+ENDIF
+
+
 ! IMPLICIT argument :
 G%LAM = .FALSE.
 
@@ -295,6 +313,8 @@ SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,&
 IF(PRESENT(LDLL)) THEN
   S%LDLL=LDLL
   IF( LDLL ) THEN
+    CALL ABORT_TRANS ('SETUP_TRANS: LDLL=.TRUE. is not yet supported with GPU backend')
+
     S%NDLON=R%NDLON
     ! account for pole + equator
     R%NDGL=R%NDGL+2
@@ -363,10 +383,14 @@ SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,&
 
 IF(PRESENT(LDGRIDONLY)) THEN
   D%LGRIDONLY=LDGRIDONLY
-ENDIF
-
-IF(PRESENT(LDSPSETUPONLY)) THEN
-  LLSPSETUPONLY=LDSPSETUPONLY
+! <<<<<<<<<<< EXTRA TO WORKAROUND NOT YET IMPLEMENTED FEATURE
+  IF (D%LGRIDONLY) THEN
+      R%NSMAX=1
+      R%NTMAX = R%NSMAX
+      WRITE(NOUT,'(A,I0)') "DEVELOPER WARNING: LDGRIDONLY IS NOT YET IMPLEMENTED CORRECTLY WITH GPU BACKEND. IGNORE AND USE TRUNCATION: ", R%NSMAX
+      D%LGRIDONLY = .FALSE.
+  ENDIF
+! >>>>>>>>>>>>>
 ENDIF
 
 IF(PRESENT(LDPNMONLY)) THEN

src/trans/gpu/external/vordiv_to_uv.F90

@@ -91,6 +91,8 @@ SUBROUTINE VORDIV_TO_UV(PSPVOR,PSPDIV,PSPU,PSPV,KSMAX,KVSETUV)
 
 IF (LHOOK) CALL DR_HOOK('VORDIV_TO_UV',0,ZHOOK_HANDLE)
 
+CALL ABORT_TRANS('VORDIV_TO_UV: Code path not (yet) supported in GPU version')
+
 !CALL GSTATS(XXXX,0)
 
 IF(MSETUP0 == 0) THEN

src/trans/gpu/internal/suleg_mod.F90

@@ -541,7 +541,7 @@ SUBROUTINE SULEG
         IF (ALLOCATED(ZLPOL)) DEALLOCATE(ZLPOL)
         !$OMP END PARALLEL
 
-        stop 'Error: code path not (yet) supported in GPU version'
+        CALL ABORT_TRANS('SULEG: Code path not (yet) supported in GPU version')
         !CALL PREPSNM(IM,JMLOC,ZEPSNM)
         ALLOCATE(S%FA(JMLOC)%RPNMWI(2*IDGLU,1:2))
         DO JGL=1,2*IDGLU

src/trans/gpu/internal/updspb_mod.F90

@@ -59,6 +59,8 @@ SUBROUTINE UPDSPB(KFIELD,POA,PSPEC,KFLDPTR)
   USE PARKIND_ECTRANS, ONLY: JPIM, JPRB, JPRBT
   USE TPM_DIM,         ONLY: R
   USE TPM_DISTR,       ONLY: D
+  USE ABORT_TRANS_MOD, ONLY: ABORT_TRANS
+
   !
 
   IMPLICIT NONE
@@ -88,7 +90,7 @@ SUBROUTINE UPDSPB(KFIELD,POA,PSPEC,KFLDPTR)
     ASSOCIATE(D_NUMP=>D%NUMP, D_MYMS=>D%MYMS, D_NASM0=>D%NASM0, R_NTMAX=>R%NTMAX)
 
     IF(PRESENT(KFLDPTR)) THEN
-       stop 'Error: code path not (yet) supported in GPU version'
+       CALL ABORT_TRANS('UPDSPB: Code path not (yet) supported in GPU version')
     ENDIF
 
   !*       1.    UPDATE SPECTRAL FIELDS.

src/trans/gpu/internal/vd2uv_mod.F90

@@ -20,6 +20,7 @@ SUBROUTINE VD2UV(KM,KMLOC,KF_UV,KLEI2,PSPVOR,PSPDIV,PU,PV)
 USE PREPSNM_MOD,     ONLY: PREPSNM
 USE PRFI1B_MOD,      ONLY: PRFI1B
 USE VDTUV_MOD,       ONLY: VDTUV
+USE ABORT_TRANS_MOD, ONLY: ABORT_TRANS
 
 
 !**** *VD2UV* - U and V from Vor/div
@@ -101,7 +102,8 @@ SUBROUTINE VD2UV(KM,KMLOC,KF_UV,KLEI2,PSPVOR,PSPDIV,PU,PV)
 !*       1.    PREPARE ZEPSNM.
 !              ---------------
 
-stop 'Error: code path not (yet) supported in GPU version'
+CALL ABORT_TRANS('VD2UV: Code path not (yet) supported in GPU version')
+
 !CALL PREPSNM(KM,KMLOC,ZEPSNM)
 
 !     ------------------------------------------------------------------
@@ -122,7 +124,6 @@ SUBROUTINE VD2UV(KM,KMLOC,KF_UV,KLEI2,PSPVOR,PSPDIV,PU,PV)
   IUU   = 6*KF_UV
   IVL   = 6*KF_UV+1
   IVU   = 8*KF_UV
-  stop 'Error: code path not (yet) supported in GPU version'
   !CALL PRFI1B(KM,ZIA(:,IVORL:IVORU),PSPVOR,KF_UV)
   !CALL PRFI1B(KM,ZIA(:,IDIVL:IDIVU),PSPDIV,KF_UV)
 

src/transi/CMakeLists.txt

@@ -39,7 +39,7 @@ if( HAVE_GPU )
     PUBLIC_INCLUDES     $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/include>
                         $<INSTALL_INTERFACE:include>
     PRIVATE_LIBS        trans_gpu_dp
-    PRIVATE_DEFINITIONS ECTRANS_HAVE_MPI=${ectrans_HAVE_MPI}
+    PRIVATE_DEFINITIONS ECTRANS_HAVE_MPI=${ectrans_HAVE_MPI} ECTRANS_GPU_VERSION
   )
   if( HAVE_ACC AND CMAKE_Fortran_COMPILER_ID MATCHES NVHPC )
     # Propagate flags as link options for downstream targets. Only required for NVHPC

src/transi/transi.c

@@ -44,7 +44,7 @@ const char* trans_error_msg(int errcode)
     case TRANS_ERROR:
   return "Trans: Error";
     case TRANS_NOTIMPL:
-  return "Trans: Not (yet) implemented";
+  return "Trans: Not implemented";
     case TRANS_MISSING_ARG:
   return "Trans: Required member of the argument structure is missing or not allocated";
     case TRANS_UNRECOGNIZED_ARG:
@@ -58,6 +58,7 @@ const char* trans_error_msg(int errcode)
 
 int trans_new( struct Trans_t* trans )
 {
+  trans->handle = 0; // not initialized
   trans->llatlon = 0;
   trans->lsplit = true;
   trans->flt = -1;
@@ -283,3 +284,7 @@ struct SpecNorm_t new_specnorm(struct Trans_t* trans)
   specnorm.count = 0;
   return specnorm;
 }
+
+void transi_disable_DR_HOOK_ASSERT_MPI_INITIALIZED() {
+  setenv("DR_HOOK_ASSERT_MPI_INITIALIZED","0",1);
+}

src/transi/transi_module.F90

@@ -410,6 +410,8 @@ subroutine transi_free(ptr) bind(C,name="transi_free")
     use, intrinsic :: iso_c_binding, only: c_ptr
     type(c_ptr), intent(in) :: ptr
   end subroutine transi_free
+  subroutine transi_disable_DR_HOOK_ASSERT_MPI_INITIALIZED() bind(C,name="transi_disable_DR_HOOK_ASSERT_MPI_INITIALIZED")
+  end subroutine
 end interface
 
 
@@ -551,6 +553,7 @@ function trans_init() bind(C,name="trans_init") result(iret)
     NPRGPNS = MPL_NPROC()
     NPRTRW = MPL_NPROC()/NPRTRV;
   else
+    call transi_disable_DR_HOOK_ASSERT_MPI_INITIALIZED()
     allocate( I_REGIONS(1) )
     NPRGPNS = 1
     NPRTRW = 1;
@@ -597,6 +600,15 @@ function trans_setup(trans) bind(C,name="trans_setup") result(iret)
   if( trans%llatlon /= 0 ) llatlon = .True.
   if( trans%llatlon == 2 ) llatlonshift = .True.
 
+#ifdef ECTRANS_GPU_VERSION
+  if (llatlon) then
+    call transi_error("trans_setup: lonlat grid input not (yet) implemented for GPU")
+    trans%handle = 0 ! Not created!
+    iret = TRANS_NOTIMPL
+    return
+  endif
+#endif
+
   if ( .not. is_init ) then
     err = trans_init()
   endif
@@ -1251,6 +1263,10 @@ function trans_delete(trans) bind(C,name="trans_delete")
   use, intrinsic :: iso_c_binding
   integer(c_int) :: trans_delete
   type(Trans_t), intent(inout) :: trans
+  trans_delete = TRANS_SUCCESS
+  if (trans%handle == 0) then
+    return
+  endif
   call free_ptr( trans%nloen       )
   call free_ptr( trans%readfp      )
   call free_ptr( trans%writefp     )
@@ -1282,7 +1298,6 @@ function trans_delete(trans) bind(C,name="trans_delete")
   call free_ptr( trans%rlapin      )
   call free_ptr( trans%ndglu       )
   call trans_release( trans%handle )
-  trans_delete = TRANS_SUCCESS
 end function trans_delete
 
 function trans_finalize() bind(C,name="trans_finalize")
@@ -1615,6 +1630,12 @@ function trans_dirtrans_adj(args) bind(C,name="trans_dirtrans_adj") result(iret)
     RGPM => RGP
   endif
 
+#ifdef ECTRANS_GPU_VERSION
+  call transi_error("trans_dirtrans_adj: ERROR: Not implemented for GPU")
+  iret = TRANS_NOTIMPL
+  return
+#endif
+
   if( args%nvordiv > 0 .and. args%nscalar > 0 ) then
     call DIR_TRANSAD( KRESOL=trans%handle, &
       &               KPROMA=args%nproma, &
@@ -1855,6 +1876,13 @@ function trans_invtrans_adj(args) bind(C,name="trans_invtrans_adj") result(iret)
     RGPM => RGP
   endif
 
+#ifdef ECTRANS_GPU_VERSION
+  call transi_error("trans_invtrans_adj: ERROR: Not implemented for GPU")
+  iret = TRANS_NOTIMPL
+  return
+#endif
+
+
   ! Note that llatlon is not an option in INV_TRANSAD unlile INV_TRANS and DIR_TRANS
   if( args%nvordiv > 0 .and. args%nscalar > 0 ) then
     call INV_TRANSAD( KRESOL=trans%handle, &
@@ -2287,6 +2315,11 @@ function trans_vordiv_to_UV(args) bind(C,name="trans_vordiv_to_UV") result(iret)
   endif
   call C_F_POINTER( args%rspv, RSPV, (/args%nfld,args%ncoeff/) )
 
+#ifdef ECTRANS_GPU_VERSION
+  call transi_error("trans_vordiv_to_UV: ERROR: Not implemented for GPU")
+  iret = TRANS_NOTIMPL
+  return
+#endif
 
   if ( .not. is_init ) then
     err = trans_init()