From 12e849435b65559816d9b6de1159239be69e550c Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 22 Feb 2019 14:54:21 +0100
Subject: [PATCH] Philippe 22/02/2019: add kind parameter for CMPLX intrinsics
(if not it default to single precision)
---
src/MNH/aeroopt_get.f90 | 98 +++++++++++++++++++-------------------
src/MNH/bhmie.f90 | 13 ++---
src/MNH/bhmie_bhcoat.f90 | 13 ++---
src/MNH/ch_ph_polyroot.f90 | 13 ++---
src/MNH/ch_solve_ph.f90 | 13 ++---
src/MNH/mode_tmat.f90 | 11 +++--
6 files changed, 81 insertions(+), 80 deletions(-)
diff --git a/src/MNH/aeroopt_get.f90 b/src/MNH/aeroopt_get.f90
index c58b83a01..485e87b68 100644
--- a/src/MNH/aeroopt_get.f90
+++ b/src/MNH/aeroopt_get.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! ###################
MODULE MODI_AEROOPT_GET
@@ -68,7 +68,8 @@
!! ------
!! Benjamin Aouizerats (CNRM/GMEI)
!!
-!!
+! Modifications:
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -160,48 +161,48 @@
DO JMDE=1,NMODE_AER
- Ri(1,1)=CMPLX(1.80,-7.40E-1)
- Ri(1,2)=CMPLX(1.80,-7.40E-1)
- Ri(1,3)=CMPLX(1.83,-7.40E-1)
- Ri(1,4)=CMPLX(1.88,-6.90E-1)
- Ri(1,5)=CMPLX(1.97,-6.80E-1)
- Ri(1,6)=CMPLX(2.10,-7.20E-1)
-
- Ri(2,1)=CMPLX(1.45,-1.00E-3)
- Ri(2,2)=CMPLX(1.45,-1.00E-3)
- Ri(2,3)=CMPLX(1.45,-1.00E-3)
- Ri(2,4)=CMPLX(1.46,-1.00E-3)
- Ri(2,5)=CMPLX(1.49,-1.00E-3)
- Ri(2,6)=CMPLX(1.42,-1.26E-2)
-
- Ri(3,1)=CMPLX(1.36,-3.60E-8)
- Ri(3,2)=CMPLX(1.34,-3.00E-9)
- Ri(3,3)=CMPLX(1.33,-1.80E-8)
- Ri(3,4)=CMPLX(1.33,-5.75E-7)
- Ri(3,5)=CMPLX(1.31,-1.28E-4)
- Ri(3,6)=CMPLX(1.42,-2.54E-1)
+ Ri(1,1)=CMPLX(1.80,-7.40E-1,kind=kind(Ri(1,1)))
+ Ri(1,2)=CMPLX(1.80,-7.40E-1,kind=kind(Ri(1,1)))
+ Ri(1,3)=CMPLX(1.83,-7.40E-1,kind=kind(Ri(1,1)))
+ Ri(1,4)=CMPLX(1.88,-6.90E-1,kind=kind(Ri(1,1)))
+ Ri(1,5)=CMPLX(1.97,-6.80E-1,kind=kind(Ri(1,1)))
+ Ri(1,6)=CMPLX(2.10,-7.20E-1,kind=kind(Ri(1,1)))
+
+ Ri(2,1)=CMPLX(1.45,-1.00E-3,kind=kind(Ri(1,1)))
+ Ri(2,2)=CMPLX(1.45,-1.00E-3,kind=kind(Ri(1,1)))
+ Ri(2,3)=CMPLX(1.45,-1.00E-3,kind=kind(Ri(1,1)))
+ Ri(2,4)=CMPLX(1.46,-1.00E-3,kind=kind(Ri(1,1)))
+ Ri(2,5)=CMPLX(1.49,-1.00E-3,kind=kind(Ri(1,1)))
+ Ri(2,6)=CMPLX(1.42,-1.26E-2,kind=kind(Ri(1,1)))
+
+ Ri(3,1)=CMPLX(1.36,-3.60E-8,kind=kind(Ri(1,1)))
+ Ri(3,2)=CMPLX(1.34,-3.00E-9,kind=kind(Ri(1,1)))
+ Ri(3,3)=CMPLX(1.33,-1.80E-8,kind=kind(Ri(1,1)))
+ Ri(3,4)=CMPLX(1.33,-5.75E-7,kind=kind(Ri(1,1)))
+ Ri(3,5)=CMPLX(1.31,-1.28E-4,kind=kind(Ri(1,1)))
+ Ri(3,6)=CMPLX(1.42,-2.54E-1,kind=kind(Ri(1,1)))
- Ri(4,1)=CMPLX(1.52,-5.00E-4)
- Ri(4,2)=CMPLX(1.52,-5.00E-4)
- Ri(4,3)=CMPLX(1.52,-5.00E-4)
- Ri(4,4)=CMPLX(1.52,-5.00E-4)
- Ri(4,5)=CMPLX(1.51,-5.00E-4)
- Ri(4,6)=CMPLX(1.35,-1.40E-2)
+ Ri(4,1)=CMPLX(1.52,-5.00E-4,kind=kind(Ri(1,1)))
+ Ri(4,2)=CMPLX(1.52,-5.00E-4,kind=kind(Ri(1,1)))
+ Ri(4,3)=CMPLX(1.52,-5.00E-4,kind=kind(Ri(1,1)))
+ Ri(4,4)=CMPLX(1.52,-5.00E-4,kind=kind(Ri(1,1)))
+ Ri(4,5)=CMPLX(1.51,-5.00E-4,kind=kind(Ri(1,1)))
+ Ri(4,6)=CMPLX(1.35,-1.40E-2,kind=kind(Ri(1,1)))
- Ri(5,1)=CMPLX(1.53,-5.00E-3)
- Ri(5,2)=CMPLX(1.53,-5.00E-3)
- Ri(5,3)=CMPLX(1.53,-6.00E-3)
- Ri(5,4)=CMPLX(1.52,-1.30E-2)
- Ri(5,5)=CMPLX(1.52,-1.30E-2)
- Ri(5,6)=CMPLX(1.45,-5.00E-1)
+ Ri(5,1)=CMPLX(1.53,-5.00E-3,kind=kind(Ri(1,1)))
+ Ri(5,2)=CMPLX(1.53,-5.00E-3,kind=kind(Ri(1,1)))
+ Ri(5,3)=CMPLX(1.53,-6.00E-3,kind=kind(Ri(1,1)))
+ Ri(5,4)=CMPLX(1.52,-1.30E-2,kind=kind(Ri(1,1)))
+ Ri(5,5)=CMPLX(1.52,-1.30E-2,kind=kind(Ri(1,1)))
+ Ri(5,6)=CMPLX(1.45,-5.00E-1,kind=kind(Ri(1,1)))
- Ri(6,1)=CMPLX(1.448,-0.00292)
- Ri(6,2)=CMPLX(1.448,-0.00292)
- Ri(6,3)=CMPLX(1.4777,-0.01897)
- Ri(6,4)=CMPLX(1.44023,-0.00116)
- Ri(6,5)=CMPLX(1.41163,-0.00106)
- Ri(6,6)=CMPLX(1.41163,-0.00106)
+ Ri(6,1)=CMPLX(1.448,-0.00292,kind=kind(Ri(1,1)))
+ Ri(6,2)=CMPLX(1.448,-0.00292,kind=kind(Ri(1,1)))
+ Ri(6,3)=CMPLX(1.4777,-0.01897,kind=kind(Ri(1,1)))
+ Ri(6,4)=CMPLX(1.44023,-0.00116,kind=kind(Ri(1,1)))
+ Ri(6,5)=CMPLX(1.41163,-0.00106,kind=kind(Ri(1,1)))
+ Ri(6,6)=CMPLX(1.41163,-0.00106,kind=kind(Ri(1,1)))
! Computation of the refractive index for the whole aerosol mode according to
! Maxwell-Garnett mixing rule
@@ -235,17 +236,18 @@
DO JWVL=1,KSWB !Number of SW wavelengths
- eps1(:,:,:)=CMPLX((Ri(1,JWVL)*VBC(:,:,:)+Ri(2,JWVL)*VOC(:,:,:)+VDDST(:,:,:)*Ri(6,JWVL))/(VBC(:,:,:)+VOC(:,:,:)))**2
- Req(:,:,:,JWVL)=sqrt(CMPLX(eps1(:,:,:)))
+ eps1(:,:,:)=CMPLX((Ri(1,JWVL)*VBC(:,:,:)+Ri(2,JWVL)*VOC(:,:,:)+VDDST(:,:,:)*Ri(6,JWVL))/(VBC(:,:,:)+VOC(:,:,:)), &
+ kind=kind(eps1(1,1,1)))**2
+ Req(:,:,:,JWVL)=sqrt(CMPLX(eps1(:,:,:),kind=kind(eps1(1,1,1))))
WHERE (VEXTR(:,:,:).NE.0. )
eps2(:,:,:)=CMPLX((VSOA(:,:,:)*Ri(2,JWVL)+VH2O(:,:,:)*Ri(3,JWVL)+VAM(:,:,:)*Ri(4,JWVL)&
+VSU(:,:,:)*Ri(4,JWVL)+VNI(:,:,:)*Ri(5,JWVL))/&
- (VSOA(:,:,:)+VH2O(:,:,:)+VAM(:,:,:)+VSU(:,:,:)+VNI(:,:,:)))**2
+ (VSOA(:,:,:)+VH2O(:,:,:)+VAM(:,:,:)+VSU(:,:,:)+VNI(:,:,:)),kind=kind(eps2(1,1,1)))**2
f1(:,:,:)=(VOC(:,:,:)+VBC(:,:,:))/(VSOA(:,:,:)+VH2O(:,:,:)+VAM(:,:,:)+VSU(:,:,:)+VNI(:,:,:)+VOC(:,:,:)+VBC(:,:,:))
eps3(:,:,:)=CMPLX(eps2(:,:,:)*(eps1(:,:,:)+2*eps2(:,:,:)+2*f1(:,:,:)*(eps1(:,:,:)-eps2(:,:,:)))/&
- (eps1(:,:,:)+2*eps2(:,:,:)-f1(:,:,:)*(eps1(:,:,:)-eps2(:,:,:))))
- Req(:,:,:,JWVL)=sqrt(CMPLX(eps3(:,:,:)))
+ (eps1(:,:,:)+2*eps2(:,:,:)-f1(:,:,:)*(eps1(:,:,:)-eps2(:,:,:))),kind=kind(eps3(1,1,1)))
+ Req(:,:,:,JWVL)=sqrt(CMPLX(eps3(:,:,:),kind=kind(eps3(1,1,1))))
ENDWHERE
ENDDO
@@ -254,8 +256,8 @@
+ZMASS(:,:,:,8,JMDE)+ZMASS(:,:,:,9,JMDE)+ZMASS(:,:,:,10,JMDE)+ZMASS(:,:,:,11,JMDE)&
+ZMASS(:,:,:,12,JMDE)+ZMASS(:,:,:,13,JMDE)+ZMASS(:,:,:,14,JMDE)+ZMASS(:,:,:,15,JMDE)&
+ZMASS(:,:,:,16,JMDE)
- PII(:,:,:,:) = aimag(CMPLX(Req(:,:,:,:)))
- PIR(:,:,:,:) = real(CMPLX(Req(:,:,:,:)))
+ PII(:,:,:,:) = aimag(CMPLX(Req(:,:,:,:),kind=kind(PII(1,1,1,1))))
+ PIR(:,:,:,:) = real( CMPLX(Req(:,:,:,:),kind=kind(PIR(1,1,1,1))))
!Get aerosol optical properties from look up tables
diff --git a/src/MNH/bhmie.f90 b/src/MNH/bhmie.f90
index 5e1d0e340..8aeb78f03 100644
--- a/src/MNH/bhmie.f90
+++ b/src/MNH/bhmie.f90
@@ -63,7 +63,8 @@ END MODULE MODI_BHMIE
!! portable. In event that portable version is
!! needed, use src/bhmie_f77.f
!! 93/06/01 (BTD): Changed AMAX1 to generic function MAX
-!! 22/01/2019 (P.Wautelet): correct kind of complex datatype
+! P. Wautelet 22/01/2019: correct kind of complex datatype
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!!***********************************************************************
!
!* 0. DECLARATIONS
@@ -151,11 +152,11 @@ ZPSI0 = COS(PSIZE_PARAM)
ZPSI1 = SIN(PSIZE_PARAM)
ZCHI0 =-SIN(PSIZE_PARAM)
ZCHI1 = COS(PSIZE_PARAM)
-ZZXI1 = CMPLX(ZPSI1,-ZCHI1)
+ZZXI1 = CMPLX(ZPSI1,-ZCHI1,kind=kind(ZZXI1))
ZONE = -1.
!
-ZZAN1 = CMPLX(0.0,0.0)
-ZZBN1 = CMPLX(0.0,0.0)
+ZZAN1 = CMPLX(0.0d0,0.0d0,kind=kind(ZZAN1))
+ZZBN1 = CMPLX(0.0d0,0.0d0,kind=kind(ZZBN1))
DO J = 1,ISTOP
ZEN = FLOAT(J)
ZFN = (2.0*ZEN+1.0)/(ZEN*(ZEN+1.0))
@@ -167,7 +168,7 @@ DO J = 1,ISTOP
!
ZPSI = (2.0*ZEN-1.0)*ZPSI1/PSIZE_PARAM-ZPSI0
ZCHI = (2.0*ZEN-1.0)*ZCHI1/PSIZE_PARAM-ZCHI0
- ZZXI = CMPLX(ZPSI,-ZCHI)
+ ZZXI = CMPLX(ZPSI,-ZCHI,kind=kind(ZZXI))
!
!*** Compute AN and BN:
!
@@ -206,7 +207,7 @@ DO J = 1,ISTOP
ZPSI1 = ZPSI
ZCHI0 = ZCHI1
ZCHI1 = ZCHI
- ZZXI1 = CMPLX(ZPSI1,-ZCHI1)
+ ZZXI1 = CMPLX(ZPSI1,-ZCHI1,kind=kind(ZZXI1))
!
!*** Compute pi_n for next value of n
! For each angle J, compute pi_n+1
diff --git a/src/MNH/bhmie_bhcoat.f90 b/src/MNH/bhmie_bhcoat.f90
index 6f315742c..c235f2ab1 100644
--- a/src/MNH/bhmie_bhcoat.f90
+++ b/src/MNH/bhmie_bhcoat.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! ########################
MODULE MODI_BHMIE_BHCOAT
@@ -46,6 +46,7 @@ END MODULE MODI_BHMIE_BHCOAT
!!
!! History:
!! 92/11/24 (BTD) Explicit declaration of all variables
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!!***********************************************************************
!
!* 0. DECLARATIONS
@@ -114,8 +115,8 @@ ZPSI0Y = COS(PSIZE_PARAM_COAT)
ZPSI1Y = SIN(PSIZE_PARAM_COAT)
ZCHI0Y =-SIN(PSIZE_PARAM_COAT)
ZCHI1Y = COS(PSIZE_PARAM_COAT)
-ZZXI0Y = CMPLX(ZPSI0Y,-ZCHI0Y)
-ZZXI1Y = CMPLX(ZPSI1Y,-ZCHI1Y)
+ZZXI0Y = CMPLX(ZPSI0Y,-ZCHI0Y,kind=kind(ZZXI0Y))
+ZZXI1Y = CMPLX(ZPSI1Y,-ZCHI1Y,kind=kind(ZZXI1Y))
!
ZZCHI0Y2 =-SIN(ZZY2)
ZZCHI1Y2 = COS(ZZY2)
@@ -130,7 +131,7 @@ DO JJ = 1,ISTOP
ZEN = FLOAT(JJ)
ZPSIY = (2.0*ZEN-1.)*ZPSI1Y/PSIZE_PARAM_COAT - ZPSI0Y
ZCHIY = (2.0*ZEN-1.)*ZCHI1Y/PSIZE_PARAM_COAT - ZCHI0Y
- ZZXIY = CMPLX(ZPSIY,-ZCHIY)
+ ZZXIY = CMPLX(ZPSIY,-ZCHIY,kind=kind(ZZXIY))
!
ZZD1Y2 = 1.0/(ZEN/ZZY2-ZZD0Y2) - ZEN/ZZY2
!
@@ -179,7 +180,7 @@ DO JJ = 1,ISTOP
ZPSI1Y = ZPSIY
ZCHI0Y = ZCHI1Y
ZCHI1Y = ZCHIY
- ZZXI1Y = CMPLX(ZPSI1Y,-ZCHI1Y)
+ ZZXI1Y = CMPLX(ZPSI1Y,-ZCHI1Y,kind=kind(ZZXI1Y))
!
ZZCHI0X2 = ZZCHI1X2
ZZCHI1X2 = ZZCHIX2
diff --git a/src/MNH/ch_ph_polyroot.f90 b/src/MNH/ch_ph_polyroot.f90
index c04194158..1ae312322 100644
--- a/src/MNH/ch_ph_polyroot.f90
+++ b/src/MNH/ch_ph_polyroot.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -34,6 +34,7 @@ END MODULE MODI_CH_PH_POLYROOT
!! MODIFICATIONS
!! -------------
!! Original 26/03/07
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -66,10 +67,10 @@ ZZDEFLATED_COEF(:) = PPCOEF(:)
! First estimate of the roots
!
DO JJ=KORDER,1,-1
- ZROOT = CMPLX(0.0,0.0)
+ ZROOT = CMPLX(0.0d0,0.0d0,kind=kind(ZROOT))
CALL LAGUERRE(ZZDEFLATED_COEF, JJ, ZROOT, IITER)
IF( ABS(AIMAG(ZROOT))<=2.0*ZEPS**(2*ABS(REAL(ZROOT))) ) THEN
- ZROOT = CMPLX(REAL(ZROOT),0.0)
+ ZROOT = CMPLX(REAL(ZROOT,kind=kind(ZROOT)),0.0d0,kind=kind(ZROOT))
END IF
PPALL_ROOTS(JJ) = ZROOT
ZB = ZZDEFLATED_COEF(JJ+1)
@@ -125,8 +126,8 @@ CONTAINS
IITS = JITER
ZZB = PA(IM+1)
ZERR = ABS(ZZB)
- ZZD = CMPLX(0.0,0.0)
- ZZF = CMPLX(0.0,0.0)
+ ZZD = CMPLX(0.0d0,0.0d0,kind=kind(ZZD))
+ ZZF = CMPLX(0.0d0,0.0d0,kind=kind(ZZF))
ZABX = ABS(PX)
DO JJ=IM,1,-1
ZZF = PX*ZZF+ZZD
@@ -154,7 +155,7 @@ CONTAINS
IF(MAX(ZABP,ZABM) > 0.0) THEN
ZZDX = FLOAT(IM)/ZZGP
ELSE
- ZZDX = EXP(CMPLX(LOG(1.0+ZABX),FLOAT(JITER)))
+ ZZDX = EXP(CMPLX(LOG(1.0+ZABX),REAL(JITER,kind=kind(ZZDX)),kind=kind(ZZDX)))
END IF
END IF
ZZX1 = PX-ZZDX
diff --git a/src/MNH/ch_solve_ph.f90 b/src/MNH/ch_solve_ph.f90
index f9b994cdf..566267544 100644
--- a/src/MNH/ch_solve_ph.f90
+++ b/src/MNH/ch_solve_ph.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source: /home//MESONH/MNH-V4-6-5/src/SRC_CHIMAQ/ch_solve_ph.f90
-!-----------------------------------------------------------------
!! #######################
MODULE MODI_CH_SOLVE_PH
!! #######################
@@ -63,6 +59,7 @@ END MODULE MODI_CH_SOLVE_PH
!! M. Leriche 16/11/07 add sulfuric acid
!! J.-P. Pinty 11/07/07 add CO3-- and SO3--
!! M. Leriche 05/06/08 add sum of ions
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!!
!! EXTERNAL
!! --------
@@ -217,9 +214,7 @@ ZCOEFS(:,2) = ZCOEFS(:,2) -2.0*(K11*K21*K3*KW*K22*(C1*K12+K12*C2))
!
ALLOCATE(ZZCOEFS(KLW,IORDER+1))
ALLOCATE(ZZROOTS(KLW,IORDER))
-DO JJ=1,IORDER+1
- ZZCOEFS(:,JJ) = CMPLX(ZCOEFS(:,JJ),0.0)
-END DO
+ZZCOEFS(:,:) = CMPLX(ZCOEFS(:,:),0.0d0,kind=kind(ZCOEFS(1,1)))
GPOLISH=.TRUE.
!
DO JI = 1, KLW
diff --git a/src/MNH/mode_tmat.f90 b/src/MNH/mode_tmat.f90
index f0c98a799..bf86fd39e 100644
--- a/src/MNH/mode_tmat.f90
+++ b/src/MNH/mode_tmat.f90
@@ -15,7 +15,8 @@
!
! Modif par Olivier Caumont (04/2008) pour interfaçage avec diagnostic
! radar de Méso-NH.
-! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
+! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
+! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
!
!****************************************************************************
@@ -1388,8 +1389,8 @@
DV1N=M*DV1(N)
DV2N=DV2(N)
- CT11=CMPLX(XRT11(M1,N,NN),XIT11(M1,N,NN))
- CT22=CMPLX(XRT22(M1,N,NN),XIT22(M1,N,NN))
+ CT11=CMPLX(XRT11(M1,N,NN),XIT11(M1,N,NN),kind=kind(CT11))
+ CT22=CMPLX(XRT22(M1,N,NN),XIT22(M1,N,NN),kind=kind(CT22))
IF (M.EQ.0) THEN
@@ -1400,8 +1401,8 @@
ELSE
- CT12=CMPLX(XRT12(M1,N,NN),XIT12(M1,N,NN))
- CT21=CMPLX(XRT21(M1,N,NN),XIT21(M1,N,NN))
+ CT12=CMPLX(XRT12(M1,N,NN),XIT12(M1,N,NN),kind=kind(CT12))
+ CT21=CMPLX(XRT21(M1,N,NN),XIT21(M1,N,NN),kind=kind(CT21))
CN1=CAL(N,NN)*FC
CN2=CAL(N,NN)*FS
--
GitLab