Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Synchronise with CY49R1.0 #60

Merged
merged 2 commits into from
Feb 13, 2024
Merged

Synchronise with CY49R1.0 #60

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
7e60708
IFS-2029: adds copyright and licence text to files released in ectrans
samhatfield Feb 7, 2024
635f9bb
Synchronise with CY49R1.0/contrib/ectrans
samhatfield Feb 7, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
53 changes: 53 additions & 0 deletions src/trans/algor/fft992.F90
View file
Open in desktop

Large diffs are not rendered by default.

19 changes: 16 additions & 3 deletions src/trans/external/gath_spec.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -83,9 +83,13 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD
INTEGER(KIND=JPIM) :: IVSET(KFGATHG)
INTEGER(KIND=JPIM) :: IFRECV,IFSEND,J
INTEGER(KIND=JPIM) :: IFLD,ICOEFF
INTEGER(KIND=JPIM) :: ISMAX, ISPEC2, ISPEC2_G
INTEGER(KIND=JPIM) :: ISMAX, ISPEC2, ISPEC2_G, ISPEC2MX
INTEGER(KIND=JPIM) :: IPOSSP(NPRTRW+1)
INTEGER(KIND=JPIM) :: IUMPP(NPRTRW)
INTEGER(KIND=JPIM) :: IPTRMS(NPRTRW)
INTEGER(KIND=JPIM),ALLOCATABLE :: IDIM0G(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: IALLMS(:)
INTEGER(KIND=JPIM),ALLOCATABLE :: IKN(:)
LOGICAL :: LLDIM1_IS_FLD
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE

Expand All @@ -112,16 +116,26 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD
ISMAX = R%NSMAX
IF(PRESENT(KSMAX)) ISMAX = KSMAX
ALLOCATE(IDIM0G(0:ISMAX))
ALLOCATE(IALLMS(ISMAX+1))
ALLOCATE(IKN(0:ISMAX))
IF(ISMAX /= R%NSMAX) THEN
CALL SUWAVEDI(ISMAX,ISMAX,NPRTRW,MYSETW,KPOSSP=IPOSSP,KSPEC2=ISPEC2,&
& KUMPP=IUMPP,KALLMS=IALLMS,KPTRMS=IPTRMS,KSPEC2MX=ISPEC2MX, &
& KDIM0G=IDIM0G)
ISPEC2_G = (ISMAX+1)*(ISMAX+2)
ELSE
ISPEC2 = D%NSPEC2
ISPEC2_G = R%NSPEC2_G
IPOSSP(:) = D%NPOSSP(:)
IDIM0G(:) = D%NDIM0G(:)
ISPEC2MX = D%NSPEC2MX
IUMPP(:) = D%NUMPP(:)
IALLMS(:) = D%NALLMS(:)
IPTRMS(:) = D%NPTRMS(:)
ENDIF
DO J=0,ISMAX
IKN(J)=2*(ISMAX+1-J)
ENDDO

IFSEND = 0
IFRECV = 0
Expand Down Expand Up @@ -182,7 +196,7 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD
ENDIF

CALL GATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,IVSET,PSPEC,LLDIM1_IS_FLD,&
& ISMAX,ISPEC2,ISPEC2_G,IPOSSP,IDIM0G,LDZA0IP)
& ISMAX,ISPEC2,ISPEC2MX,ISPEC2_G,IPOSSP,IDIM0G,IUMPP,IALLMS,IPTRMS,IKN,LDZA0IP)
DEALLOCATE(IDIM0G)

IF (LHOOK) CALL DR_HOOK('GATH_SPEC',1,ZHOOK_HANDLE)
Expand All @@ -191,4 +205,3 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD
! ------------------------------------------------------------------

END SUBROUTINE GATH_SPEC

12 changes: 10 additions & 2 deletions src/trans/external/setup_trans0.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,&
& KPRGPNS,KPRGPEW,KPRTRW,KCOMBFLEN,&
& LDMPOFF,LDSYNC_TRANS,KTRANS_SYNC_LEVEL,&
& LDEQ_REGIONS,K_REGIONS_NS,K_REGIONS_EW,K_REGIONS,&
& PRAD,LDALLOPERM)
& PRAD,LDALLOPERM,KOPT_MEMORY_TR)

!**** *SETUP_TRANS0* - General setup routine for transform package

Expand Down Expand Up @@ -44,6 +44,8 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,&
! K_REGIONS_EW - Maximum number of EW partitions
! PRAD - Radius of the planet
! LDALLOPERM - Allocate certain arrays permanently
! KOPT_MEMORY_TR - memory strategy (stack vs heap) in gripoint transpositions

! The total number of (MPI)-processors has to be equal to KPRGPNS*KPRGPEW

! Method.
Expand All @@ -62,6 +64,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,&
! R. El Khatib 03-01-24 LDMPOFF
! G. Mozdzynski 2006-09-13 LDEQ_REGIONS
! N. Wedi 2009-11-30 add radius
! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR

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

Expand All @@ -70,7 +73,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,&
!ifndef INTERFACE

USE TPM_GEN ,ONLY : NERR, NOUT, LMPOFF, LSYNC_TRANS, NTRANS_SYNC_LEVEL, MSETUP0, &
& NMAX_RESOL, NPRINTLEV, NPROMATR, LALLOPERM
& NMAX_RESOL, NPRINTLEV, NPROMATR, LALLOPERM, NSTACK_MEMORY_TR
USE TPM_DISTR ,ONLY : LEQ_REGIONS, NCOMBFLEN, NPRGPEW,NPRGPNS, NPRTRW
USE TPM_CONSTANTS ,ONLY : RA

Expand All @@ -91,6 +94,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,&
LOGICAL ,OPTIONAL,INTENT(IN) :: LDEQ_REGIONS
LOGICAL ,OPTIONAL,INTENT(IN) :: LDALLOPERM
REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PRAD
INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KOPT_MEMORY_TR
INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS(:)
INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS_NS
INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS_EW
Expand Down Expand Up @@ -124,6 +128,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,&
LEQ_REGIONS=.FALSE.
RA=6371229._JPRB
LALLOPERM=.FALSE.
NSTACK_MEMORY_TR=0

! Optional arguments

Expand Down Expand Up @@ -180,6 +185,9 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,&
IF(PRESENT(LDEQ_REGIONS)) THEN
LEQ_REGIONS = LDEQ_REGIONS
ENDIF
IF(PRESENT(KOPT_MEMORY_TR))THEN
NSTACK_MEMORY_TR = KOPT_MEMORY_TR
ENDIF

! Initial setup
CALL SUMP_TRANS0
Expand Down
10 changes: 5 additions & 5 deletions src/trans/include/ectrans/get_current.h
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
! (C) Copyright 2000- ECMWF.
! (C) Copyright 2000- Meteo France.
! (C) Copyright 2000- 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.
!

INTERFACE
SUBROUTINE GET_CURRENT(KRESOL,LDLAM)
Expand All @@ -22,15 +22,15 @@ SUBROUTINE GET_CURRENT(KRESOL,LDLAM)
! CALL GET_CURRENT(...)

! Explicit arguments : (all optional)
! --------------------
! --------------------
! KRESOL - Current resolution
! LDLAM - .T. if the corresponding resolution is LAM, .F. if it is global

! Method.
! -------

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

! Author.
! -------
Expand Down
5 changes: 4 additions & 1 deletion src/trans/include/ectrans/setup_trans0.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,&
& KPRGPNS,KPRGPEW,KPRTRW,KCOMBFLEN,&
& LDMPOFF,LDSYNC_TRANS,KTRANS_SYNC_LEVEL,&
& LDEQ_REGIONS,K_REGIONS_NS,K_REGIONS_EW,K_REGIONS,&
& PRAD,LDALLOPERM)
& PRAD,LDALLOPERM,KOPT_MEMORY_TR)

!**** *SETUP_TRANS0* - General setup routine for transform package

Expand Down Expand Up @@ -45,6 +45,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,&
! K_REGIONS_EW - Maximum number of EW partitions
! PRAD - Radius of the planet
! LDALLOPERM - Allocate certain arrays permanently
! KOPT_MEMORY_TR - memory strategy (stack vs heap) in gripoint transpositions

! The total number of (MPI)-processors has to be equal to KPRGPNS*KPRGPEW

Expand All @@ -64,6 +65,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,&
! R. El Khatib 03-01-24 LDMPOFF
! G. Mozdzynski 2006-09-13 LDEQ_REGIONS
! N. Wedi 2009-11-30 add radius
! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR

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

Expand All @@ -79,6 +81,7 @@ INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KTRANS_SYNC_LEVEL
LOGICAL ,OPTIONAL,INTENT(IN) :: LDEQ_REGIONS
LOGICAL ,OPTIONAL,INTENT(IN) :: LDALLOPERM
REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PRAD
INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KOPT_MEMORY_TR
INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS(:)
INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS_NS
INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS_EW
Expand Down
11 changes: 6 additions & 5 deletions src/trans/internal/dist_spec_control_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,9 @@ SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,&
! --------------
! Original : 2000-04-01
! P.Marguinaud : 2014-10-10
! R. El Khatib 25-Jul-2019 Optimization by vectorization, proper non-blocking comms and overlapp send/recv with pack/unpack
! R. El Khatib 25-Jul-2019 Optimization by vectorization, proper non-blocking comms
! and overlapp send/recv with pack/unpack
! R. El Khatib 02-Jun-2022 Optimization/Cleaning
! ------------------------------------------------------------------

USE PARKIND1 ,ONLY : JPIM ,JPRB
Expand All @@ -65,11 +67,11 @@ SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,&

IMPLICIT NONE

REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPECG(:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN), CONTIGUOUS :: PSPECG(:,:)
INTEGER(KIND=JPIM) , INTENT(IN) :: KFDISTG
INTEGER(KIND=JPIM) , INTENT(IN) :: KFROM(:)
INTEGER(KIND=JPIM) , INTENT(IN) :: KVSET(:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPEC(:,:)
REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT), CONTIGUOUS :: PSPEC(:,:)
LOGICAL , INTENT(IN) :: LDIM1_IS_FLD
INTEGER(KIND=JPIM) , INTENT(IN) :: KSMAX
INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2
Expand All @@ -87,7 +89,7 @@ SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,&
REAL(KIND=JPRB), ALLOCATABLE :: ZBUF(:,:,:)
INTEGER(KIND=JPIM) :: IASM0G(0:KSMAX)
INTEGER(KIND=JPIM) :: JM,IFLDR,IFLD,JFLD,ITAG,ILEN(NPRTRW),JA,ISND(NPRTRV,NPRTRW), JB, IFLDOFF
INTEGER(KIND=JPIM) :: IRCV,ISTP(NPRTRW),ISENDREQ(NPROC), IREQRCV(NPROC), IPROC(NPROC), JMLOC, IFLDBUF, IFLDSPG, IPOSSP
INTEGER(KIND=JPIM) :: IRCV,ISENDREQ(NPROC), IREQRCV(NPROC), IPROC(NPROC), JMLOC, IFLDBUF, IFLDSPG, IPOSSP
INTEGER(KIND=JPIM) :: ISENT, INR, IOFFPROC(NPROC+1), IFLDLOC(KFDISTG), ILOCFLD(KFDISTG)
INTEGER(KIND=JPIM), POINTER :: ISORT (:)

Expand All @@ -107,7 +109,6 @@ SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,&

DO JA=1,NPRTRW
ILEN(JA) = KPOSSP(JA+1)-KPOSSP(JA)
ISTP(JA) = KPOSSP(JA+1)-1
ENDDO
DO JA=1,NPRTRW
DO JB=1,NPRTRV
Expand Down
21 changes: 19 additions & 2 deletions src/trans/internal/ftdir_ctl_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -52,11 +52,13 @@ SUBROUTINE FTDIR_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, &
! Modifications.
! --------------
! Original : 00-03-03

! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR
! R. El Khatib 01-Jun-2022 contiguous pointer
! ------------------------------------------------------------------

USE PARKIND1 ,ONLY : JPIM ,JPRB

USE TPM_GEN ,ONLY : NSTACK_MEMORY_TR
USE TPM_TRANS ,ONLY : FOUBUF_IN
USE TPM_DISTR ,ONLY : D, MYPROC, NPROC

Expand All @@ -83,7 +85,9 @@ SUBROUTINE FTDIR_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, &
REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGP2(:,:,:)

! Local variables
REAL(KIND=JPRB) :: ZGTF(KF_FS,D%NLENGTF)
REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF)
REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:)
REAL(KIND=JPRB),POINTER, CONTIGUOUS :: ZGTF(:,:)

INTEGER(KIND=JPIM) :: IST,JGL,IGL,IBLEN
INTEGER(KIND=JPIM) :: IVSETUV(KF_UV_G)
Expand Down Expand Up @@ -139,6 +143,19 @@ SUBROUTINE FTDIR_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, &
IST = IST+KF_SCALARS_G
ENDIF

IF (NSTACK_MEMORY_TR == 1) THEN
ZGTF => ZGTF_STACK(:,:)
ELSE
ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF))
! Now, force the OS to allocate this shared array right now, not when it starts
! to be used which is an OPEN-MP loop, that would cause a threads
! synchronization lock :
IF (KF_FS > 0 .AND. D%NLENGTF > 0) THEN
ZGTF_HEAP(1,1)=HUGE(1._JPRB)
ENDIF
ZGTF => ZGTF_HEAP(:,:)
ENDIF

! Transposition

CALL GSTATS(158,0)
Expand Down
19 changes: 17 additions & 2 deletions src/trans/internal/ftdir_ctlad_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -52,11 +52,13 @@ SUBROUTINE FTDIR_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, &
! Modifications.
! --------------
! Original : 00-03-03
! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR

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

USE PARKIND1 ,ONLY : JPIM ,JPRB

USE TPM_GEN ,ONLY : NSTACK_MEMORY_TR
USE TPM_DISTR ,ONLY : D, MYPROC, NPROC
USE TRLTOG_MOD ,ONLY : TRLTOG
USE FOURIER_OUTAD_MOD ,ONLY : FOURIER_OUTAD
Expand All @@ -81,8 +83,9 @@ SUBROUTINE FTDIR_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, &
REAL(KIND=JPRB),OPTIONAL , INTENT(OUT) :: PGP2(:,:,:)

! Local variables
REAL(KIND=JPRB) :: ZGTF(KF_FS,D%NLENGTF)

REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF)
REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:)
REAL(KIND=JPRB),POINTER :: ZGTF(:,:)

INTEGER(KIND=JPIM) :: IST
INTEGER(KIND=JPIM) :: IVSETUV(KF_UV_G)
Expand All @@ -98,6 +101,18 @@ SUBROUTINE FTDIR_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, &

CALL GSTATS(133,0)

IF (NSTACK_MEMORY_TR == 1) THEN
ZGTF => ZGTF_STACK(:,:)
ELSE
ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF))
! Now, force the OS to allocate this shared array right now, not when it starts
! to be used which is an OPEN-MP loop, that would cause a threads synchronization lock :
IF (KF_FS > 0 .AND. D%NLENGTF > 0) THEN
ZGTF_HEAP(1,1)=HUGE(1._JPRB)
ENDIF
ZGTF => ZGTF_HEAP(:,:)
ENDIF

IF(MYPROC > NPROC/2)THEN
IBEG=1
IEND=D%NDGL_FS
Expand Down
6 changes: 2 additions & 4 deletions src/trans/internal/ftdir_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ SUBROUTINE FTDIR(PREEL,KFIELDS,KGL)
IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS,KGL
REAL(KIND=JPRB), INTENT(INOUT) :: PREEL(:,:)
REAL(KIND=JPRB), POINTER, CONTIGUOUS, INTENT(INOUT) :: PREEL(:,:)

INTEGER(KIND=JPIM) :: IGLG,IST,ILEN,IJUMP,JJ,JF,IST1
INTEGER(KIND=JPIM) :: IOFF,IRLEN,ICLEN, ITYPE
Expand Down Expand Up @@ -113,9 +113,7 @@ SUBROUTINE FTDIR(PREEL,KFIELDS,KGL)
IST1=1
IF (G%NLOEN(IGLG)==1) IST1=0
DO JJ=IST1,ILEN
DO JF=1,KFIELDS
PREEL(JF,IST+D%NSTAGTF(KGL)+JJ-1) = 0.0_JPRB
ENDDO
PREEL(1:KFIELDS,IST+D%NSTAGTF(KGL)+JJ-1) = 0.0_JPRB
ENDDO

! ------------------------------------------------------------------
Expand Down
29 changes: 18 additions & 11 deletions src/trans/internal/ftinv_ctl_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,12 +57,13 @@ SUBROUTINE FTINV_CTL(KF_UV_G,KF_SCALARS_G,&
! Modifications.
! --------------
! Original : 00-03-03
! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR

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

USE PARKIND1 ,ONLY : JPIM ,JPRB

USE TPM_GEN ,ONLY : NERR
USE TPM_GEN ,ONLY : NERR ,NSTACK_MEMORY_TR
USE TPM_TRANS ,ONLY : LDIVGP, LSCDERS, LUVDER, LVORGP,LATLON
USE TPM_DISTR ,ONLY : D, MYPROC, NPROC
USE TPM_FLT ,ONLY : S
Expand Down Expand Up @@ -112,16 +113,10 @@ SUBROUTINE FTINV_CTL(KF_UV_G,KF_SCALARS_G,&
#else
REAL(KIND=JPRB),TARGET,ALLOCATABLE :: ZDUM(:,:) ! When using this (HEAP) alloc Cray CCE 8.6.2 fails in OMP 1639
#endif
!REAL(KIND=JPRB),TARGET :: ZGTF(KF_FS,D%NLENGTF) ! A stack hog ?
REAL(KIND=JPRB),TARGET,ALLOCATABLE :: ZGTF(:,:) ! (KF_FS,D%NLENGTF)

ALLOCATE(ZGTF(KF_FS,D%NLENGTF))
! Certain compilers allocate arrays at the moment they start to be used, not at the moment the user
! allocates them. This is a problem if that moment is an open-mp loop because it would trigger
! an omp barrier to let the array be allocated by the master thread if the array is shared (which
! is the case here for zgtf).
! Therefore the next line ensures zgtf is really allocated here, not inside the omp loop. REK
IF (KF_FS > 0 .AND. D%NLENGTF > 0) ZGTF(1,1)=0._JPRB
REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF)
REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:)
REAL(KIND=JPRB),POINTER :: ZGTF(:,:)

#if 1
ALLOCATE(ZDUM(1,D%NLENGTF))
Expand All @@ -139,6 +134,18 @@ SUBROUTINE FTINV_CTL(KF_UV_G,KF_SCALARS_G,&

CALL GSTATS(107,0)

IF (NSTACK_MEMORY_TR == 1) THEN
ZGTF => ZGTF_STACK(:,:)
ELSE
ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF))
! Now, force the OS to allocate this shared array right now, not when it starts
! to be used which is an OPEN-MP loop, that would cause a threads synchronization lock :
IF (KF_FS > 0 .AND. D%NLENGTF > 0) THEN
ZGTF_HEAP(1,1)=HUGE(1._JPRB)
ENDIF
ZGTF => ZGTF_HEAP(:,:)
ENDIF

IF (KF_UV > 0 .OR. KF_SCDERS > 0 .OR. (LATLON.AND.S%LDLL) ) THEN
IST = 1
IF (LVORGP) THEN
Expand Down Expand Up @@ -289,7 +296,7 @@ SUBROUTINE FTINV_CTL(KF_UV_G,KF_SCALARS_G,&

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

DEALLOCATE(ZGTF)
!DEALLOCATE(ZGTF)

END SUBROUTINE FTINV_CTL
END MODULE FTINV_CTL_MOD
Loading
Loading