dealloc_resol_mod.F90 Source File

! (C) Copyright 2013- ECMWF.
! (C) Copyright 2013- Meteo-France.
! 
! 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 PARKIND1  ,ONLY : JPIM

USE TPM_DIM         ,ONLY : R
USE TPM_GEN         ,ONLY : LENABLED, NOUT,NDEF_RESOL
USE TPM_DISTR       ,ONLY : D,NPRTRV
USE TPM_GEOMETRY    ,ONLY : G
USE TPM_FIELDS      ,ONLY : F
USE TPM_FFTW        ,ONLY : DESTROY_PLANS_FFTW
USE TPM_FLT         ,ONLY : S
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

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

IF (.NOT.LENABLED(KRESOL)) THEN

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

ELSE

  CALL SET_RESOL(KRESOL)

  !TPM_FLT
  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( S%LUSEFLT .AND. ILA > S%ITHRESHOLD) THEN
        ELSE
          IF(.NOT.C%CIO_TYPE == 'mbuf' .AND. ASSOCIATED(S%FA(IMLOC)%RPNMA)) DEALLOCATE(S%FA(IMLOC)%RPNMA)
        ENDIF
        IF( S%LUSEFLT .AND. ILS > S%ITHRESHOLD) THEN
        ELSE
          IF(.NOT.C%CIO_TYPE == 'mbuf' .AND. ASSOCIATED(S%FA(IMLOC)%RPNMS)) DEALLOCATE(S%FA(IMLOC)%RPNMS)
        ENDIF
        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

  !TPM_DISTR
  IF(ALLOCATED(D%NFRSTLAT)) DEALLOCATE(D%NFRSTLAT)
  IF(ALLOCATED(D%NLSTLAT)) DEALLOCATE(D%NLSTLAT)
  IF(ALLOCATED(D%NPTRLAT)) DEALLOCATE(D%NPTRLAT)
  IF(ALLOCATED(D%NPTRFRSTLAT)) DEALLOCATE(D%NPTRFRSTLAT)
  IF(ALLOCATED(D%NPTRLSTLAT)) DEALLOCATE(D%NPTRLSTLAT)
  IF(ALLOCATED(D%LSPLITLAT)) DEALLOCATE(D%LSPLITLAT)
  IF(ALLOCATED(D%NSTA)) DEALLOCATE(D%NSTA)
  IF(ALLOCATED(D%NONL)) DEALLOCATE(D%NONL)
  IF(ALLOCATED(D%NGPTOTL)) DEALLOCATE(D%NGPTOTL)
  IF(ALLOCATED(D%NPROCA_GP)) DEALLOCATE(D%NPROCA_GP)

  IF(D%LWEIGHTED_DISTR) THEN
    IF(ALLOCATED(D%RWEIGHT)) DEALLOCATE(D%RWEIGHT)
  ENDIF

  IF(ALLOCATED(D%MYMS)) DEALLOCATE(D%MYMS)
  IF(ALLOCATED(D%NUMPP)) DEALLOCATE(D%NUMPP)
  IF(ALLOCATED(D%NPOSSP)) DEALLOCATE(D%NPOSSP)
  IF(ALLOCATED(D%NPROCM)) DEALLOCATE(D%NPROCM)
  IF(ALLOCATED(D%NDIM0G)) DEALLOCATE(D%NDIM0G)
  IF(ALLOCATED(D%NASM0)) DEALLOCATE(D%NASM0)
  IF(ALLOCATED(D%NATM0)) DEALLOCATE(D%NATM0)
  IF(ALLOCATED(D%NLATLS)) DEALLOCATE(D%NLATLS)
  IF(ALLOCATED(D%NLATLE)) DEALLOCATE(D%NLATLE)
  IF(ALLOCATED(D%NPMT)) DEALLOCATE(D%NPMT)
  IF(ALLOCATED(D%NPMS)) DEALLOCATE(D%NPMS)
  IF(ALLOCATED(D%NPMG)) DEALLOCATE(D%NPMG)
  IF(ALLOCATED(D%NULTPP)) DEALLOCATE(D%NULTPP)
  IF(ALLOCATED(D%NPROCL)) DEALLOCATE(D%NPROCL)
  IF(ALLOCATED(D%NPTRLS)) DEALLOCATE(D%NPTRLS)
  IF(ALLOCATED(D%NALLMS)) DEALLOCATE(D%NALLMS)
  IF(ALLOCATED(D%NPTRMS)) DEALLOCATE(D%NPTRMS)
  IF(ALLOCATED(D%NSTAGT0B)) DEALLOCATE(D%NSTAGT0B)
  IF(ALLOCATED(D%NSTAGT1B)) DEALLOCATE(D%NSTAGT1B)
  IF(ALLOCATED(D%NPNTGTB0)) DEALLOCATE(D%NPNTGTB0)
  IF(ALLOCATED(D%NPNTGTB1)) DEALLOCATE(D%NPNTGTB1)
  IF(ALLOCATED(D%NLTSFTB)) DEALLOCATE(D%NLTSFTB)
  IF(ALLOCATED(D%NLTSGTB)) DEALLOCATE(D%NLTSGTB)
  IF(ALLOCATED(D%MSTABF)) DEALLOCATE(D%MSTABF)
  IF(ALLOCATED(D%NSTAGTF)) DEALLOCATE(D%NSTAGTF)

  !TPM_FFTW
  CALL DESTROY_PLANS_FFTW

  !TPM_FIELDS
  IF(ALLOCATED(F%RMU)) DEALLOCATE(F%RMU)
  IF(ALLOCATED(F%RW)) DEALLOCATE(F%RW)
  IF(ALLOCATED(F%R1MU2)) DEALLOCATE(F%R1MU2)
  IF(ALLOCATED(F%RACTHE)) DEALLOCATE(F%RACTHE)
  IF(ALLOCATED(F%REPSNM)) DEALLOCATE(F%REPSNM)
  IF(ALLOCATED(F%RN)) DEALLOCATE(F%RN)
  IF(ALLOCATED(F%RLAPIN)) DEALLOCATE(F%RLAPIN)
  IF(ALLOCATED(F%NLTN)) DEALLOCATE(F%NLTN)
  IF( S%LKEEPRPNM ) THEN
    IF(ALLOCATED(F%RPNM)) DEALLOCATE(F%RPNM)
  ENDIF
  IF( S%LDLL ) THEN
    IF(ALLOCATED(F%RMU2)) DEALLOCATE(F%RMU2)
    IF(ALLOCATED(F%RACTHE2)) DEALLOCATE(F%RACTHE2)
  ENDIF

  !TPM_GEOMETRY
  IF(ALLOCATED(G%NMEN)) DEALLOCATE(G%NMEN)
  IF(ALLOCATED(G%NDGLU)) DEALLOCATE(G%NDGLU)
  IF(ALLOCATED(G%NLOEN)) DEALLOCATE(G%NLOEN)

  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