! (C) Copyright 2013- ECMWF.
! (C) Copyright 2013- Meteo-France.
! (C) Copyright 2024- NVIDIA.
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
!

MODULE DEALLOC_RESOL_MOD
CONTAINS
SUBROUTINE DEALLOC_RESOL(KRESOL)

!**** *DEALLOC_RESOL* - Deallocations of a resolution

!     Purpose.
!     --------
!     Release allocated arrays for a given resolution

!**   Interface.
!     ----------
!     CALL DEALLOC_RESOL

!     Explicit arguments : KRESOL : resolution tag
!     --------------------

!     Method.
!     -------

!     Externals.  None
!     ----------

!     Author.
!     -------
!        R. El Khatib *METEO-FRANCE*

!     Modifications.
!     --------------
!        Original : 09-Jul-2013 from trans_end

!     ------------------------------------------------------------------

USE PARKIND_ECTRANS, ONLY: JPIM
USE TPM_DIM,         ONLY: R, DIM_TYPE
USE TPM_GEN,         ONLY: LENABLED, NOUT, NDEF_RESOL
USE TPM_DISTR,       ONLY: D, DISTR_TYPE, NPRTRV
USE TPM_GEOMETRY,    ONLY: G, GEOM_TYPE
USE TPM_FIELDS,      ONLY: F, FIELDS_TYPE
USE TPM_FIELDS_GPU,  ONLY: FG, FIELDS_GPU_TYPE
USE TPM_HICFFT,      ONLY: CLEAN_FFT
USE HICBLAS_MOD,     ONLY: CLEAN_GEMM
USE TPM_FLT,         ONLY: S, FLT_TYPE_WRAP
USE TPM_CTL,         ONLY: C
USE SEEFMM_MIX,      ONLY: FREE_SEEFMM
USE SET_RESOL_MOD,   ONLY: SET_RESOL
!

IMPLICIT NONE

INTEGER(KIND=JPIM),  INTENT(IN) :: KRESOL
INTEGER(KIND=JPIM) :: JMLOC,IPRTRV,JSETV,IMLOC,IM,ILA,ILS, JRESOL
TYPE(DIM_TYPE) :: R_
TYPE(DISTR_TYPE) :: D_
TYPE(GEOM_TYPE) :: G_
TYPE(FIELDS_TYPE) :: F_
TYPE(FIELDS_GPU_TYPE) :: FG_
TYPE(FLT_TYPE_WRAP) :: S_

!     ------------------------------------------------------------------

IF (.NOT.LENABLED(KRESOL)) THEN

  WRITE(UNIT=NOUT,FMT='('' DEALLOC_RESOL WARNING : KRESOL = '',I3,'' ALREADY DISABLED '')') KRESOL

ELSE

  CALL SET_RESOL(KRESOL)

#ifdef ACCGPU
!$ACC EXIT DATA DELETE(R) ASYNC(1)
!$ACC EXIT DATA DELETE(FG%ZAA0,FG%ZAS0) IF(ALLOCATED(FG%ZAA0)) ASYNC(1)
!$ACC EXIT DATA DELETE(FG%ZAA,FG%ZAS,FG%ZEPSNM) ASYNC(1)
!$ACC EXIT DATA DELETE(FG) ASYNC(1)
!$ACC EXIT DATA DELETE(F,F%RLAPIN,F%RACTHE,F%RW) ASYNC(1)
!$ACC EXIT DATA DELETE(D,D%MYMS,D%NPNTGTB0,D%NPNTGTB1,D%NSTAGT0B,D%NSTAGT1B,D%NSTAGTF,D%NPROCM)&
!$ACC&          DELETE(D%NPROCL,D%NPTRLS,D%MSTABF,D%NASM0,D%OFFSETS_GEMM1,D%OFFSETS_GEMM2) ASYNC(1)
!$ACC EXIT DATA DELETE(G,G%NDGLU,G%NMEN,G%NLOEN) ASYNC(1)
!$ACC WAIT(1)
#endif
#ifdef OMPGPU
#endif

  ! TPM_FLD is more complex because it has pointers
  IF( ALLOCATED(S%FA) ) THEN
    DO JMLOC=1,D%NUMP,NPRTRV  ! +++++++++++++++++++++ JMLOC LOOP ++++++++++
      IPRTRV=MIN(NPRTRV,D%NUMP-JMLOC+1)
      DO JSETV=1,IPRTRV
        IMLOC=JMLOC+JSETV-1
        IM = D%MYMS(IMLOC)
        ILA = (R%NSMAX-IM+2)/2
        ILS = (R%NSMAX-IM+3)/2
        IF(.NOT.C%CIO_TYPE == 'mbuf' .AND. ASSOCIATED(S%FA(IMLOC)%RPNMA)) DEALLOCATE(S%FA(IMLOC)%RPNMA)
        IF(.NOT.C%CIO_TYPE == 'mbuf' .AND. ASSOCIATED(S%FA(IMLOC)%RPNMS)) DEALLOCATE(S%FA(IMLOC)%RPNMS)
        IF(S%LDLL) THEN
          IF(.NOT.C%CIO_TYPE == 'mbuf' .AND. ASSOCIATED(S%FA(IMLOC)%RPNMWI)) DEALLOCATE(S%FA(IMLOC)%RPNMWI)
          IF(.NOT.C%CIO_TYPE == 'mbuf' .AND. ASSOCIATED(S%FA(IMLOC)%RPNMWO)) DEALLOCATE(S%FA(IMLOC)%RPNMWO)
        ENDIF
      ENDDO
    ENDDO
    DEALLOCATE(S%FA)
  ENDIF
  IF(S%LDLL) THEN
    CALL FREE_SEEFMM(S%FMM_INTI)
    IF(ASSOCIATED(S%FMM_INTI)) DEALLOCATE(S%FMM_INTI)
  ENDIF
  S = S_

  ! Empty all fields (none of them has pointers; allocatable arrays implicitly deallocate)
  R_%NSMAX = 0 ! Avoids warning of unused R_ with Cray compiler
  D = D_
  F = F_
  FG = FG_
  R = R_
  G = G_

  CALL CLEAN_FFT(KRESOL)
  CALL CLEAN_GEMM(KRESOL)

  LENABLED(KRESOL)=.FALSE.
  NDEF_RESOL = COUNT(LENABLED)
  ! Do not stay on a disabled resolution
  DO JRESOL=1,SIZE(LENABLED)
    IF (LENABLED(JRESOL)) THEN
      CALL SET_RESOL(JRESOL)
      EXIT
    ENDIF
  ENDDO

ENDIF
!     ------------------------------------------------------------------

END SUBROUTINE DEALLOC_RESOL
END MODULE DEALLOC_RESOL_MOD
