Merge pull request #60 from samhatfield/samhatfield/sync_with_CY49R1.…

…0_contrib

Synchronise with CY49R1.0

src/trans/external/gath_spec.F90

@@ -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
 
@@ -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
@@ -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)
@@ -191,4 +205,3 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD
 !     ------------------------------------------------------------------
 
 END SUBROUTINE GATH_SPEC
-

src/trans/external/setup_trans0.F90

@@ -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
 
@@ -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.
@@ -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
 
 !     ------------------------------------------------------------------
 
@@ -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
 
@@ -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
@@ -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
 
@@ -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

src/trans/include/ectrans/get_current.h

@@ -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)
@@ -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.
 !     -------

src/trans/include/ectrans/setup_trans0.h

@@ -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
 
@@ -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
 
@@ -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
 
 !     ------------------------------------------------------------------
 
@@ -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

src/trans/internal/dist_spec_control_mod.F90

@@ -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
@@ -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
@@ -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 (:)
 
@@ -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

src/trans/internal/ftdir_ctl_mod.F90

@@ -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
 
@@ -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)
@@ -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)

src/trans/internal/ftdir_ctlad_mod.F90

@@ -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
@@ -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)
@@ -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

src/trans/internal/ftdir_mod.F90

@@ -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
@@ -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
 
 !     ------------------------------------------------------------------

src/trans/internal/ftinv_ctl_mod.F90

@@ -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
@@ -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))
@@ -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
@@ -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