Skip to content

Commit 4cad834

Browse files
SebastienRietteMTOSebastienRietteMTO
committed
Lima execution in mixed precision
1 parent 9572d32 commit 4cad834

8 files changed

+419
-31
lines changed

‎build/with_fcm/arch/arch-gnu32.env

Whitespace-only changes.

‎build/with_fcm/arch/arch-gnu32.fcm

+27
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
# Compilation
2+
$FCOMPILER = gfortran
3+
$BASE_FFLAGS = -c -fPIC -ffree-line-length-none -fopenmp -fconvert=swap -fallow-argument-mismatch
4+
$PROD_FFLAGS = -O2
5+
$DEV_FFLAGS = -O1
6+
$DEBUG_FFLAGS = -O0 -g -fbounds-check -finit-real=snan -ffpe-trap=invalid,zero,overflow
7+
$CCOMPILER = gcc
8+
$BASE_CFLAGS = -c -fPIC -fopenmp
9+
$PROD_CFLAGS = -O2
10+
$DEV_CFLAGS = -O1
11+
$DEBUG_CFLAGS = -fbounds-check
12+
$OMP_FFLAGS =
13+
14+
# Preprocessor
15+
$FPP_FLAGS = LINUX LITTLE_ENDIAN LITTLE REPRO48 PARKIND1_SINGLE
16+
$CPP_FLAGS = LINUX LITTLE_ENDIAN LITTLE PARKIND1_SINGLE
17+
$FPP_FLAGS_TESTPROGS = WITHOUT_CXXDEMANGLE USE_OPENMP
18+
19+
# Linker
20+
$LINK = gfortran
21+
$BASE_LD = -fPIC -fdefault-real-8 -fdefault-double-8 -fopenmp
22+
$OMP_LD =
23+
$LD_EXE_TO_SHARED = -shared
24+
25+
# Other
26+
$AR = ar
27+

‎src/common/micro/lima.F90

+6-6
Original file line numberDiff line numberDiff line change
@@ -149,12 +149,12 @@ SUBROUTINE LIMA ( D, CST, ICED, ICEP, ELECD, ELECP, BUCONF, TBUDGETS, KBUDGETS,
149149
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCCT, ZCRT, ZCIT, ZCST, ZCGT, ZCHT
150150
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZTHS, ZRVS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS
151151
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCCS, ZCRS, ZCIS, ZCSS, ZCGS, ZCHS
152-
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NCCN) :: ZCCNFT, ZCCNAT
153-
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NCCN) :: ZCCNFS, ZCCNAS
154-
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIFN) :: ZIFNFT, ZIFNNT
155-
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIFN) :: ZIFNFS, ZIFNNS
156-
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIMM) :: ZIMMNT
157-
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NIMM) :: ZIMMNS
152+
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NMOD_CCN) :: ZCCNFT, ZCCNAT
153+
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NMOD_CCN) :: ZCCNFS, ZCCNAS
154+
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NMOD_IFN) :: ZIFNFT, ZIFNNT
155+
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NMOD_IFN) :: ZIFNFS, ZIFNNS
156+
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NMOD_IMM) :: ZIMMNT
157+
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NMOD_IMM) :: ZIMMNS
158158
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZHOMFT
159159
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZHOMFS
160160

‎src/common/micro/mode_ini_lima_cold_mixed.F90

+5-4
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,7 @@ SUBROUTINE INI_LIMA_COLD_MIXED (PTSTEP, PDZMIN)
5252
USE MODD_PARAM_LIMA_MIXED
5353
!
5454
use mode_msg
55+
USE MODD_PRECISION, ONLY: MNHREAL64
5556
!
5657
USE MODE_LIMA_FUNCTIONS, ONLY: MOMG, GAUHER
5758
USE MODI_GAMMA
@@ -315,13 +316,13 @@ SUBROUTINE INI_LIMA_COLD_MIXED (PTSTEP, PDZMIN)
315316
!Cas GAMMAGEN
316317
XALPHAS = .214 ! Generalized gamma law
317318
XNUS = 43.7 ! Generalized gamma law
318-
XTRANS_MP_GAMMAS = SQRT( ( GAMMA(XNUS + 2./XALPHAS)*GAMMA(XNUS + 4./XALPHAS) ) / &
319-
( 8.* GAMMA(XNUS + 1./XALPHAS)*GAMMA(XNUS + 3./XALPHAS) ) )
319+
XTRANS_MP_GAMMAS = SQRT( ( GAMMA(DBLE(XNUS + 2._MNHREAL64/XALPHAS))*GAMMA(DBLE(XNUS + 4._MNHREAL64/XALPHAS)) ) / &
320+
( 8._MNHREAL64* GAMMA(DBLE(XNUS + 1._MNHREAL64/XALPHAS))*GAMMA(DBLE(XNUS + 3._MNHREAL64/XALPHAS)) ) )
320321
ELSE IF (NMOM_S.EQ.2) THEN
321322
XALPHAS = 1.0 ! Gamma law
322323
XNUS = 2.0 !
323-
XTRANS_MP_GAMMAS = SQRT( ( GAMMA(XNUS + 2./XALPHAS)*GAMMA(XNUS + 4./XALPHAS) ) / &
324-
( 8.* GAMMA(XNUS + 1./XALPHAS)*GAMMA(XNUS + 3./XALPHAS) ) )
324+
XTRANS_MP_GAMMAS = SQRT( ( GAMMA(DBLE(XNUS + 2._MNHREAL64/XALPHAS))*GAMMA(DBLE(XNUS + 4._MNHREAL64/XALPHAS)) ) / &
325+
( 8._MNHREAL64* GAMMA(DBLE(XNUS + 1._MNHREAL64/XALPHAS))*GAMMA(DBLE(XNUS + 3._MNHREAL64/XALPHAS)) ) )
325326
ELSE
326327
XALPHAS = 1.0 ! Exponential law
327328
XNUS = 1.0 ! Exponential law

‎src/common/micro/mode_ini_rain_ice.F90

+3-2
Original file line numberDiff line numberDiff line change
@@ -99,6 +99,7 @@ SUBROUTINE INI_RAIN_ICE ( KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD )
9999
& XFRACM90, XFRMIN_NAM, XRDEPGRED_NAM, XRDEPSRED_NAM
100100
USE MODD_RAIN_ICE_DESCR_n
101101
USE MODD_RAIN_ICE_PARAM_n
102+
USE MODD_PRECISION, ONLY: MNHREAL64
102103
!
103104
USE MODI_GAMMA
104105
USE MODI_GAMMA_INC
@@ -392,8 +393,8 @@ SUBROUTINE INI_RAIN_ICE ( KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD )
392393
!Cas GAMMAGEN
393394
XALPHAS = .214 ! Generalized gamma law
394395
XNUS = 43.7 ! Generalized gamma law
395-
XTRANS_MP_GAMMAS = SQRT( ( GAMMA(XNUS + 2./XALPHAS)*GAMMA(XNUS + 4./XALPHAS) ) / &
396-
( 8.* GAMMA(XNUS + 1./XALPHAS)*GAMMA(XNUS + 3./XALPHAS) ) )
396+
XTRANS_MP_GAMMAS = SQRT( ( GAMMA(DBLE(XNUS + 2._MNHREAL64/XALPHAS))*GAMMA(DBLE(XNUS + 4._MNHREAL64/XALPHAS)) ) / &
397+
( 8._MNHREAL64* GAMMA(DBLE(XNUS + 1._MNHREAL64/XALPHAS))*GAMMA(DBLE(XNUS + 3._MNHREAL64/XALPHAS)) ) )
397398
ELSE
398399
XALPHAS = 1.0 ! Exponential law
399400
XNUS = 1.0 ! Exponential law

‎src/common/micro/mode_lima_init_ccn_activation_spectrum.F90

+22-15
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,8 @@ SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,
3939
USE MODI_GAMMA_INC
4040
USE MODI_HYPGEO
4141
USE MODI_HYPSER
42+
USE MODD_PRECISION, ONLY: MNHREAL64
43+
USE MODI_MINPACK
4244
!
4345
IMPLICIT NONE
4446
!
@@ -55,13 +57,13 @@ SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,
5557
!
5658
!* 0.2 Declarations of local variables :
5759
!
58-
INTEGER, PARAMETER :: M = 1000 ! Number of points (S,Nccn) used to fit the spectra
59-
INTEGER, PARAMETER :: N = 3 ! Number of parameters to adjust
60-
REAL, DIMENSION(N) :: PARAMS ! Parameters to adjust by the LM algorithm (k, mu, beta)
61-
REAL, DIMENSION(M) :: FVEC ! Array to store the distance between theoretical and fitted spectra
60+
INTEGER(KIND=4), PARAMETER :: M = 1000 ! Number of points (S,Nccn) used to fit the spectra
61+
INTEGER(KIND=4), PARAMETER :: N = 3 ! Number of parameters to adjust
62+
REAL(KIND=MNHREAL64), DIMENSION(N) :: PARAMS ! Parameters to adjust by the LM algorithm (k, mu, beta)
63+
REAL(KIND=MNHREAL64), DIMENSION(M) :: FVEC ! Array to store the distance between theoretical and fitted spectra
6264
INTEGER :: IFLAG !
63-
INTEGER :: INFO !
64-
REAL :: TOL = 1.E-16 ! Fit precision required
65+
INTEGER(KIND=4) :: INFO !
66+
REAL(KIND=MNHREAL64) :: TOL = 1.E-16 ! Fit precision required
6567
!
6668
INTEGER :: II, IJ ! Loop indices
6769
!
@@ -152,8 +154,9 @@ SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE_CCN,XD,XSIGMA,XLIMIT_FACTOR,
152154
!* 3. Compute C, k, mu, beta, using the Levenberg-Marquardt algorithm
153155
! ---------------------------------------------------------------
154156
!
155-
PARAMS(1:3) = (/ 1., 1., 1000. /)
157+
PARAMS(1:3) = (/ 1._MNHREAL64, 1._MNHREAL64, 1000._MNHREAL64 /)
156158
IFLAG = 1
159+
!lmdif1 uses KIND 8 reals and KIND 4 integers
157160
call lmdif1 ( DISTANCE, M, N, PARAMS, FVEC, TOL, INFO )
158161
!
159162
XLIMIT_FACTOR = gamma(PARAMS(2))*PARAMS(3)**(PARAMS(1)/2)/gamma(1+PARAMS(1)/2)/gamma(PARAMS(2)-PARAMS(1)/2)
@@ -333,6 +336,7 @@ FUNCTION DSDD(XD,XDDRY,XKAPPA, XT) RESULT(DS)
333336
!* 0. DECLARATIONS
334337
!
335338
USE MODD_CST, ONLY : XMV, XAVOGADRO, XBOLTZ, XRHOLW
339+
USE MODD_PRECISION, ONLY: MNHREAL64
336340
!
337341
IMPLICIT NONE
338342
!
@@ -348,10 +352,12 @@ FUNCTION DSDD(XD,XDDRY,XKAPPA, XT) RESULT(DS)
348352
!* 0.2 declarations of local variables
349353
!
350354
REAL :: XA ! factor inside the exponential
355+
REAL(KIND=MNHREAL64) :: Z
351356
!
352357
XA = 4 * 0.072 * XMV / XAVOGADRO / XBOLTZ / XT / XRHOLW
353-
DS = (XD**3-XDDRY**3) * (XD**3-(1-XKAPPA)*XDDRY**3) * XA - 3. * XKAPPA * XD**4 * XDDRY**3
354-
DS = DS * EXP(XA/XD) / (XD**3-(1-XKAPPA)*XDDRY**3)**2
358+
Z = (XD**3-XDDRY**3) * (XD**3-(1._MNHREAL64-XKAPPA)*XDDRY**3) * XA - 3._MNHREAL64 * XKAPPA * DBLE(XD)**4 * DBLE(XDDRY)**3
359+
Z = Z * EXP(XA/XD) / (XD**3-(1-XKAPPA)*XDDRY**3)**2
360+
DS = Z
355361
!
356362
END FUNCTION DSDD
357363
!
@@ -396,11 +402,12 @@ SUBROUTINE DISTANCE(M,N,X,FVEC,IFLAG)
396402
!
397403
!* 0.1 declarations of arguments and result
398404
!
399-
integer, intent(in) :: M
400-
integer, intent(in) :: N
401-
real, intent(in) :: X(N)
402-
real, intent(out) :: FVEC(M)
403-
integer, intent(inout) :: IFLAG
405+
!DISTANCE must use KIND 8 reals and KIND 4 integers to be used by LMDIF1
406+
integer(KIND=4), intent(in) :: M
407+
integer(KIND=4), intent(in) :: N
408+
real(KIND=MNHREAL64), intent(in) :: X(N)
409+
real(KIND=MNHREAL64), intent(out) :: FVEC(M)
410+
integer(KIND=4), intent(inout) :: IFLAG
404411
!
405412
!* 0.2 declarations of local variables
406413
!
@@ -416,7 +423,7 @@ SUBROUTINE DISTANCE(M,N,X,FVEC,IFLAG)
416423
DO I=1, M
417424
! XS in "no units", ie XS=0.01 for a 1% suersaturation
418425
! ZW= C * (XS(I)/100)**X(1) * HYPGEO(X(2),X(1)/2,X(1)/2+1,X(3),XS(I)/100)
419-
ZW= C * (XS(I))**X(1) * HYPGEO(X(2),X(1)/2,X(1)/2+1,X(3),XS(I))
426+
ZW= C * (XS(I))**X(1) * HYPGEO(REAL(X(2)), REAL(X(1)/2), REAL(X(1)/2+1), REAL(X(3)), REAL(XS(I)))
420427
!!$ IF (X(3)*(XS(I)/100)**2 .LT. 0.98) THEN
421428
!!$ CALL HYPSER(X(2),X(1)/2,X(1)/2+1,-X(3)*(XS(I)/100)**2,ZW2)
422429
!!$ print *, "args= ", X(2), X(1)/2, X(1)/2+1, -X(3)*(XS(I)/100)**2, " hypser = ", ZW2

0 commit comments

Comments
 (0)