! (C) Copyright 2000- ECMWF. ! (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. ! MODULE LTINV_CTLAD_MOD CONTAINS SUBROUTINE LTINV_CTLAD(KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,& & PSPVOR,PSPDIV,PSPSCALAR,& & PSPSC3A,PSPSC3B,PSPSC2,& & KFLDPTRUV,KFLDPTRSC,FSPGL_PROC) !**** *LTINV_CTLAD* - Control routine for inverse Legandre transform - adj. ! Purpose. ! -------- ! Control routine for the inverse LEGENDRE transform !** Interface. ! ---------- ! CALL INV_TRANS_CTL(...) ! KF_OUT_LT - number of fields coming out from inverse LT ! KF_UV - local number of spectral u-v fields ! KF_SCALARS - local number of scalar spectral fields ! KF_SCDERS - local number of derivatives of scalar spectral fields ! PSPVOR(:,:) - spectral vorticity (input) ! PSPDIV(:,:) - spectral divergence (input) ! PSPSCALAR(:,:) - spectral scalarvalued fields (input) ! KFLDPTRUV(:) - field pointer array for vor./div. ! KFLDPTRSC(:) - field pointer array for PSPSCALAR ! FSPGL_PROC - external procedure to be executed in fourier space ! before transposition ! Method. ! ------- ! Externals. ! ---------- ! ! Author. ! ------- ! Mats Hamrud *ECMWF* ! Modifications. ! -------------- ! Original : 00-06-03 ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB USE TPM_GEN ,ONLY : LALLOPERM !USE TPM_DIM USE TPM_TRANS ,ONLY : FOUBUF, FOUBUF_IN USE TPM_DISTR ,ONLY : D USE LTINVAD_MOD ,ONLY : LTINVAD USE TRLTOM_MOD ,ONLY : TRLTOM IMPLICIT NONE INTEGER(KIND=JPIM),INTENT(IN) :: KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:) REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:) REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:) REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3A(:,:,:) REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3B(:,:,:) REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC2(:,:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) EXTERNAL FSPGL_PROC OPTIONAL FSPGL_PROC INTEGER(KIND=JPIM) :: JM,IM,IBLEN,ILEI2,IDIM1 ! ------------------------------------------------------------------ ILEI2 = 8*KF_UV + 2*KF_SCALARS + 2*KF_SCDERS IDIM1 = 2*KF_OUT_LT IBLEN = D%NLENGT0B*2*KF_OUT_LT IF (ALLOCATED(FOUBUF_IN)) THEN IF (MAX(1,IBLEN) > SIZE(FOUBUF_IN)) THEN DEALLOCATE(FOUBUF_IN) ALLOCATE(FOUBUF_IN(MAX(1,IBLEN))) ENDIF ELSE ALLOCATE(FOUBUF_IN(MAX(1,IBLEN))) ENDIF CALL GSTATS(180,0) CALL TRLTOM(FOUBUF,FOUBUF_IN,2*KF_OUT_LT) CALL GSTATS(180,1) IF (.NOT.LALLOPERM) DEALLOCATE(FOUBUF) CALL GSTATS(104,0) CALL GSTATS(1648,0) IF(KF_OUT_LT > 0) THEN ! Bug in gcc <= 10.2, see https://github.com/ecmwf-ifs/ectrans/issues/20 #if !(defined(__GFORTRAN__) && __GNUC__ == 10 && __GNUC_MINOR__ <= 2) !$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JM,IM) #endif DO JM=1,D%NUMP IM = D%MYMS(JM) CALL LTINVAD(IM,JM,KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,ILEI2,IDIM1,& & PSPVOR,PSPDIV,PSPSCALAR,& & PSPSC3A,PSPSC3B,PSPSC2 , & & KFLDPTRUV,KFLDPTRSC,FSPGL_PROC) ENDDO #if !(defined(__GFORTRAN__) && __GNUC__ == 10 && __GNUC_MINOR__ <= 2) !$OMP END PARALLEL DO #endif ENDIF CALL GSTATS(1648,1) IF (.NOT.LALLOPERM) DEALLOCATE(FOUBUF_IN) CALL GSTATS(104,1) ! ------------------------------------------------------------------ END SUBROUTINE LTINV_CTLAD END MODULE LTINV_CTLAD_MOD