C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C:::##INCLUDE '~/charmm_fcm/number.fcm'
- REAL*8 ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX,
+ REAL(KIND=8) ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX,
& SEVEN, EIGHT, NINE, TEN, ELEVEN, TWELVE, THIRTN,
& FIFTN, NINETN, TWENTY, THIRTY
C..##IF SINGLE
& TWELVE = 12.D0, THIRTN = 13.D0, FIFTN = 15.D0,
& NINETN = 19.D0, TWENTY = 20.D0, THIRTY = 30.D0)
C..##ENDIF
- REAL*8 FIFTY, SIXTY, SVNTY2, EIGHTY, NINETY, HUNDRD,
+ REAL(KIND=8) FIFTY, SIXTY, SVNTY2, EIGHTY, NINETY, HUNDRD,
& ONE2TY, ONE8TY, THRHUN, THR6TY, NINE99, FIFHUN, THOSND,
& FTHSND,MEGA
C..##IF SINGLE
& THR6TY=360.D0, NINE99 = 999.D0, FIFHUN = 1500.D0,
& THOSND = 1000.D0,FTHSND = 5000.D0, MEGA = 1.0D6)
C..##ENDIF
- REAL*8 MINONE, MINTWO, MINSIX
+ REAL(KIND=8) MINONE, MINTWO, MINSIX
PARAMETER (MINONE = -1.D0, MINTWO = -2.D0, MINSIX = -6.D0)
- REAL*8 TENM20,TENM14,TENM8,TENM5,PT0001,PT0005,PT001,PT005,
+ REAL(KIND=8) TENM20,TENM14,TENM8,TENM5,PT0001,PT0005,PT001,PT005,
& PT01, PT02, PT05, PTONE, PT125, PT25, SIXTH, THIRD,
& PTFOUR, PTSIX, HALF, PT75, PT9999, ONEPT5, TWOPT4
C..##IF SINGLE
& PTSIX = 0.6D0, PT75 = 0.75D0, PT9999 = 0.9999D0,
& ONEPT5 = 1.5D0, TWOPT4 = 2.4D0)
C..##ENDIF
- REAL*8 ANUM,FMARK
- REAL*8 RSMALL,RBIG
+ REAL(KIND=8) ANUM,FMARK
+ REAL(KIND=8) RSMALL,RBIG
C..##IF SINGLE
C..##ELSE
PARAMETER (ANUM=9999.0D0, FMARK=-999.0D0)
PARAMETER (RSMALL=1.0D-10,RBIG=1.0D20)
C..##ENDIF
- REAL*8 RPRECI,RBIGST
+ REAL(KIND=8) RPRECI,RBIGST
C..##IF VAX DEC
C..##ELIF IBM
C..##ELIF CRAY
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C:::##INCLUDE '~/charmm_fcm/consta.fcm'
- REAL*8 PI,RADDEG,DEGRAD,TWOPI
+ REAL(KIND=8) PI,RADDEG,DEGRAD,TWOPI
PARAMETER(PI=3.141592653589793D0,TWOPI=2.0D0*PI)
PARAMETER (RADDEG=180.0D0/PI)
PARAMETER (DEGRAD=PI/180.0D0)
- REAL*8 COSMAX
+ REAL(KIND=8) COSMAX
PARAMETER (COSMAX=0.9999999999D0)
- REAL*8 TIMFAC
+ REAL(KIND=8) TIMFAC
PARAMETER (TIMFAC=4.88882129D-02)
- REAL*8 KBOLTZ
+ REAL(KIND=8) KBOLTZ
PARAMETER (KBOLTZ=1.987191D-03)
- REAL*8 CCELEC
+ REAL(KIND=8) CCELEC
C..##IF AMBER
C..##ELIF DISCOVER
C..##ELSE
PARAMETER (CCELEC=332.0716D0)
C..##ENDIF
- REAL*8 CNVFRQ
+ REAL(KIND=8) CNVFRQ
PARAMETER (CNVFRQ=2045.5D0/(2.99793D0*6.28319D0))
- REAL*8 SPEEDL
+ REAL(KIND=8) SPEEDL
PARAMETER (SPEEDL=2.99793D-02)
- REAL*8 ATMOSP
+ REAL(KIND=8) ATMOSP
PARAMETER (ATMOSP=1.4584007D-05)
- REAL*8 PATMOS
+ REAL(KIND=8) PATMOS
PARAMETER (PATMOS = 1.D0 / ATMOSP )
- REAL*8 BOHRR
+ REAL(KIND=8) BOHRR
PARAMETER (BOHRR = 0.529177249D0 )
- REAL*8 TOKCAL
+ REAL(KIND=8) TOKCAL
PARAMETER (TOKCAL = 627.5095D0 )
C..##IF MMFF
- real*8 MDAKCAL
+ REAL(KIND=8) MDAKCAL
parameter(MDAKCAL=143.9325D0)
C..##ENDIF
- REAL*8 DEBYEC
+ REAL(KIND=8) DEBYEC
PARAMETER ( DEBYEC = 2.541766D0 / BOHRR )
- REAL*8 ZEROC
+ REAL(KIND=8) ZEROC
PARAMETER ( ZEROC = 298.15D0 )
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
LOGICAL CHKPTR, EQST, EQSTA, EQSTWC, EQWDWC, DOTRIM, CHECQUE,
* HYDROG, INITIA, LONE, LTSTEQ, ORDER, ORDER5,
* ORDERR, USEDDT, QTOKDEL, QDIGIT, QALPHA
- REAL*8 DECODF, DOTVEC, GTRMF, LENVEC, NEXTF, RANDOM, GTRR8,
+ REAL(KIND=8) DECODF, DOTVEC, GTRMF, LENVEC, NEXTF, RANDOM, GTRR8,
* RANUMB, R8VAL, RETVAL8, SUMVEC
C..##IF ADUMB
* ,UMFI
external LEQUIV, LPATH
external nbndx, nbnd2, nbnd3, NTERMA
external find_loc
- real*8 vangle, OOPNGL, TORNGL, ElementMass
+ REAL(KIND=8) vangle, OOPNGL, TORNGL, ElementMass
external vangle, OOPNGL, TORNGL, ElementMass
C..##ENDIF
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C:::##INCLUDE '~/charmm_fcm/deriv.fcm'
- REAL*8 DX,DY,DZ
+ REAL(KIND=8) DX,DY,DZ
COMMON /DERIVR/ DX(MAXAIM),DY(MAXAIM),DZ(MAXAIM)
C..##IF SAVEFCM
C..##ENDIF
COMMON /ANER/ CEPROP(LENENP), CETERM(LENENT), CEPRSS(LENENV)
LOGICAL QEPROP, QETERM, QEPRSS
COMMON /QENER/ QEPROP(LENENP), QETERM(LENENT), QEPRSS(LENENV)
- REAL*8 EPROP, ETERM, EPRESS
+ REAL(KIND=8) EPROP, ETERM, EPRESS
COMMON /ENER/ EPROP(LENENP), ETERM(LENENT), EPRESS(LENENV)
C..##IF SAVEFCM
C..##ENDIF
- REAL*8 EPRPA, EPRP2A, EPRPP, EPRP2P,
+ REAL(KIND=8) EPRPA, EPRP2A, EPRPP, EPRP2P,
& ETRMA, ETRM2A, ETRMP, ETRM2P,
& EPRSA, EPRS2A, EPRSP, EPRS2P
COMMON /ENACCM/ EPRPA(LENENP), ETRMA(LENENT), EPRSA(LENENV),
C..##ENDIF
INTEGER ECALLS, TOT1ST, TOT2ND
COMMON /EMISCI/ ECALLS, TOT1ST, TOT2ND
- REAL*8 EOLD, FITA, DRIFTA, EAT0A, CORRA, FITP, DRIFTP,
+ REAL(KIND=8) EOLD, FITA, DRIFTA, EAT0A, CORRA, FITP, DRIFTP,
& EAT0P, CORRP
COMMON /EMISCR/ EOLD, FITA, DRIFTA, EAT0A, CORRA,
& FITP, DRIFTP, EAT0P, CORRP
C..##IF FLUCQ
C..##ENDIF
C..##IF TSM
- REAL*8 TSMTRM(LENENT),TSMTMP(LENENT)
+ REAL(KIND=8) TSMTRM(LENENT),TSMTMP(LENENT)
COMMON /TSMENG/ TSMTRM,TSMTMP
C...##IF SAVEFCM
C...##ENDIF
C..##ENDIF
- REAL*8 EHQBM
+ REAL(KIND=8) EHQBM
LOGICAL HQBM
COMMON /HQBMVAR/HQBM
C..##IF SAVEFCM
INTEGER INBCMP(*),JNBCMP(*),PARDIM
INTEGER ITMX,IUNMOD,IUNRMD,SAVF
INTEGER NBOND,IB(*),JB(*)
- REAL*8 X(*),Y(*),Z(*),AMASS(*),DDSCR(*)
- REAL*8 DDV(NAT3,*),PARDDV(PARDIM,*),DDM(*),DDS(*)
- REAL*8 DDF(*),PARDDF(*),DDEV(*),PARDDE(*)
- REAL*8 DD1BLK(*),DD1BLL(*),DD1CMP(*)
- REAL*8 TOLDIM,DDVALM
- REAL*8 PARFRQ,CUTF1
+ REAL(KIND=8) X(*),Y(*),Z(*),AMASS(*),DDSCR(*)
+ REAL(KIND=8) DDV(NAT3,*),PARDDV(PARDIM,*),DDM(*),DDS(*)
+ REAL(KIND=8) DDF(*),PARDDF(*),DDEV(*),PARDDE(*)
+ REAL(KIND=8) DD1BLK(*),DD1BLL(*),DD1CMP(*)
+ REAL(KIND=8) TOLDIM,DDVALM
+ REAL(KIND=8) PARFRQ,CUTF1
LOGICAL LNOMA,LRAISE,LSCI,LBIG
C Local variables
INTEGER NATOM,NATP,NDIM,I,J,II,OLDFAS,OLDPRN,IUPD
INTEGER SCIFV1,SCIFV2,SCIFV3,SCIFV4,SCIFV6
INTEGER DRATQ,ERATQ,E2RATQ,BDRATQ,INRATQ
INTEGER I620,I640,I660,I700,I720,I760,I800,I840,I880,I920
- REAL*8 CVGMX,TOLER
+ REAL(KIND=8) CVGMX,TOLER
LOGICAL LCARD,LAPPE,LPURG,LWDINI,QCALC,QMASWT,QMIX,QDIAG
C Begin
QCALC=.TRUE.
logical fail
integer i, i2, ia, i3
- integer*2 j, j2, j3, ja
- integer*1 k, k2, k3, ka
- integer*8 m, m2, m3, ma
+ integer(kind=2) j, j2, j3, ja
+ integer(kind=1) k, k2, k3, ka
+ integer(kind=8) m, m2, m3, ma
common /flags/ fail
fail = .false.
ja = ja + 1
j = ishft(j,-1)
end do
- call c_i2(BIT_SIZE(j),ja,'BIT_SIZE(integer*2)')
+ call c_i2(BIT_SIZE(j),ja,'BIT_SIZE(integer(2))')
ka = 0
k = 0
k = not(k)
ka = ka + 1
k = ishft(k,-1)
end do
- call c_i1(BIT_SIZE(k),ka,'BIT_SIZE(integer*1)')
+ call c_i1(BIT_SIZE(k),ka,'BIT_SIZE(integer(1))')
ma = 0
m = 0
m = not(m)
ma = ma + 1
m = ishft(m,-1)
end do
- call c_i8(BIT_SIZE(m),ma,'BIT_SIZE(integer*8)')
+ call c_i8(BIT_SIZE(m),ma,'BIT_SIZE(integer(8))')
c BTEST - Section 13.13.17
j = 7
m = 7
m2 = 3
call c_l(BTEST(7,3),.true.,'BTEST(integer,integer)')
- call c_l(BTEST(7,j2),.true.,'BTEST(integer,integer*2)')
- call c_l(BTEST(7,k2),.true.,'BTEST(integer,integer*1)')
- call c_l(BTEST(7,m2),.true.,'BTEST(integer,integer*8)')
- call c_l(BTEST(j,3),.true.,'BTEST(integer*2,integer)')
- call c_l(BTEST(j,j2),.true.,'BTEST(integer*2,integer*2)')
- call c_l(BTEST(j,k2),.true.,'BTEST(integer*2,integer*1)')
- call c_l(BTEST(j,m2),.true.,'BTEST(integer*2,integer*8)')
- call c_l(BTEST(k,3),.true.,'BTEST(integer*1,integer)')
- call c_l(BTEST(k,j2),.true.,'BTEST(integer*1,integer*2)')
- call c_l(BTEST(k,k2),.true.,'BTEST(integer*1,integer*1)')
- call c_l(BTEST(k,m2),.true.,'BTEST(integer*1,integer*8)')
- call c_l(BTEST(m,3),.true.,'BTEST(integer*8,integer)')
- call c_l(BTEST(m,j2),.true.,'BTEST(integer*8,integer*2)')
- call c_l(BTEST(m,k2),.true.,'BTEST(integer*8,integer*1)')
- call c_l(BTEST(m,m2),.true.,'BTEST(integer*8,integer*8)')
+ call c_l(BTEST(7,j2),.true.,'BTEST(integer,integer(2))')
+ call c_l(BTEST(7,k2),.true.,'BTEST(integer,integer(1))')
+ call c_l(BTEST(7,m2),.true.,'BTEST(integer,integer(8))')
+ call c_l(BTEST(j,3),.true.,'BTEST(integer(2),integer)')
+ call c_l(BTEST(j,j2),.true.,'BTEST(integer(2),integer(2))')
+ call c_l(BTEST(j,k2),.true.,'BTEST(integer(2),integer(1))')
+ call c_l(BTEST(j,m2),.true.,'BTEST(integer(2),integer(8))')
+ call c_l(BTEST(k,3),.true.,'BTEST(integer(1),integer)')
+ call c_l(BTEST(k,j2),.true.,'BTEST(integer(1),integer(2))')
+ call c_l(BTEST(k,k2),.true.,'BTEST(integer(1),integer(1))')
+ call c_l(BTEST(k,m2),.true.,'BTEST(integer(1),integer(8))')
+ call c_l(BTEST(m,3),.true.,'BTEST(integer(8),integer)')
+ call c_l(BTEST(m,j2),.true.,'BTEST(integer(8),integer(2))')
+ call c_l(BTEST(m,k2),.true.,'BTEST(integer(8),integer(1))')
+ call c_l(BTEST(m,m2),.true.,'BTEST(integer(8),integer(8))')
c IAND - Section 13.13.40
j = 3
m2 = 1
ma = 1
call c_i(IAND(3,1),1,'IAND(integer,integer)')
- call c_i2(IAND(j,j2),ja,'IAND(integer*2,integer*2)')
- call c_i1(IAND(k,k2),ka,'IAND(integer*1,integer*1)')
- call c_i8(IAND(m,m2),ma,'IAND(integer*8,integer*8)')
+ call c_i2(IAND(j,j2),ja,'IAND(integer(2),integer(2)')
+ call c_i1(IAND(k,k2),ka,'IAND(integer(1),integer(1))')
+ call c_i8(IAND(m,m2),ma,'IAND(integer(8),integer(8))')
c IBCLR - Section 13.13.41
m2 = 1
ma = 12
call c_i(IBCLR(14,1),12,'IBCLR(integer,integer)')
- call c_i(IBCLR(14,j2),12,'IBCLR(integer,integer*2)')
- call c_i(IBCLR(14,k2),12,'IBCLR(integer,integer*1)')
- call c_i(IBCLR(14,m2),12,'IBCLR(integer,integer*8)')
- call c_i2(IBCLR(j,1),ja,'IBCLR(integer*2,integer)')
- call c_i2(IBCLR(j,j2),ja,'IBCLR(integer*2,integer*2)')
- call c_i2(IBCLR(j,k2),ja,'IBCLR(integer*2,integer*1)')
- call c_i2(IBCLR(j,m2),ja,'IBCLR(integer*2,integer*8)')
- call c_i1(IBCLR(k,1),ka,'IBCLR(integer*1,integer)')
- call c_i1(IBCLR(k,j2),ka,'IBCLR(integer*1,integer*2)')
- call c_i1(IBCLR(k,k2),ka,'IBCLR(integer*1,integer*1)')
- call c_i1(IBCLR(k,m2),ka,'IBCLR(integer*1,integer*8)')
- call c_i8(IBCLR(m,1),ma,'IBCLR(integer*8,integer)')
- call c_i8(IBCLR(m,j2),ma,'IBCLR(integer*8,integer*2)')
- call c_i8(IBCLR(m,k2),ma,'IBCLR(integer*8,integer*1)')
- call c_i8(IBCLR(m,m2),ma,'IBCLR(integer*8,integer*8)')
+ call c_i(IBCLR(14,j2),12,'IBCLR(integer,integer(2))')
+ call c_i(IBCLR(14,k2),12,'IBCLR(integer,integer(1))')
+ call c_i(IBCLR(14,m2),12,'IBCLR(integer,integer(8))')
+ call c_i2(IBCLR(j,1),ja,'IBCLR(integer(2),integer)')
+ call c_i2(IBCLR(j,j2),ja,'IBCLR(integer(2),integer(2))')
+ call c_i2(IBCLR(j,k2),ja,'IBCLR(integer(2),integer(1))')
+ call c_i2(IBCLR(j,m2),ja,'IBCLR(integer(2),integer(8))')
+ call c_i1(IBCLR(k,1),ka,'IBCLR(integer(1),integer)')
+ call c_i1(IBCLR(k,j2),ka,'IBCLR(integer(1),integer(2))')
+ call c_i1(IBCLR(k,k2),ka,'IBCLR(integer(1),integer(1))')
+ call c_i1(IBCLR(k,m2),ka,'IBCLR(integer(1),integer(8))')
+ call c_i8(IBCLR(m,1),ma,'IBCLR(integer(8),integer)')
+ call c_i8(IBCLR(m,j2),ma,'IBCLR(integer(8),integer(2))')
+ call c_i8(IBCLR(m,k2),ma,'IBCLR(integer(8),integer(1))')
+ call c_i8(IBCLR(m,m2),ma,'IBCLR(integer(8),integer(8))')
c IBSET - Section 13.13.43
j = 12
m2 = 1
ma = 14
call c_i(IBSET(12,1),14,'IBSET(integer,integer)')
- call c_i(IBSET(12,j2),14,'IBSET(integer,integer*2)')
- call c_i(IBSET(12,k2),14,'IBSET(integer,integer*1)')
- call c_i(IBSET(12,m2),14,'IBSET(integer,integer*8)')
- call c_i2(IBSET(j,1),ja,'IBSET(integer*2,integer)')
- call c_i2(IBSET(j,j2),ja,'IBSET(integer*2,integer*2)')
- call c_i2(IBSET(j,k2),ja,'IBSET(integer*2,integer*1)')
- call c_i2(IBSET(j,m2),ja,'IBSET(integer*2,integer*8)')
- call c_i1(IBSET(k,1),ka,'IBSET(integer*1,integer)')
- call c_i1(IBSET(k,j2),ka,'IBSET(integer*1,integer*2)')
- call c_i1(IBSET(k,k2),ka,'IBSET(integer*1,integer*1)')
- call c_i1(IBSET(k,m2),ka,'IBSET(integer*1,integer*8)')
- call c_i8(IBSET(m,1),ma,'IBSET(integer*8,integer)')
- call c_i8(IBSET(m,j2),ma,'IBSET(integer*8,integer*2)')
- call c_i8(IBSET(m,k2),ma,'IBSET(integer*8,integer*1)')
- call c_i8(IBSET(m,m2),ma,'IBSET(integer*8,integer*8)')
+ call c_i(IBSET(12,j2),14,'IBSET(integer,integer(2))')
+ call c_i(IBSET(12,k2),14,'IBSET(integer,integer(1))')
+ call c_i(IBSET(12,m2),14,'IBSET(integer,integer(8))')
+ call c_i2(IBSET(j,1),ja,'IBSET(integer(2),integer)')
+ call c_i2(IBSET(j,j2),ja,'IBSET(integer(2),integer(2))')
+ call c_i2(IBSET(j,k2),ja,'IBSET(integer(2),integer(1))')
+ call c_i2(IBSET(j,m2),ja,'IBSET(integer(2),integer(8))')
+ call c_i1(IBSET(k,1),ka,'IBSET(integer(1),integer)')
+ call c_i1(IBSET(k,j2),ka,'IBSET(integer(1),integer(2))')
+ call c_i1(IBSET(k,k2),ka,'IBSET(integer(1),integer(1))')
+ call c_i1(IBSET(k,m2),ka,'IBSET(integer(1),integer(8))')
+ call c_i8(IBSET(m,1),ma,'IBSET(integer(8),integer)')
+ call c_i8(IBSET(m,j2),ma,'IBSET(integer(8),integer(2))')
+ call c_i8(IBSET(m,k2),ma,'IBSET(integer(8),integer(1))')
+ call c_i8(IBSET(m,m2),ma,'IBSET(integer(8),integer(8))')
c IEOR - Section 13.13.45
j = 3
m2 = 1
ma = 2
call c_i(IEOR(3,1),2,'IEOR(integer,integer)')
- call c_i2(IEOR(j,j2),ja,'IEOR(integer*2,integer*2)')
- call c_i1(IEOR(k,k2),ka,'IEOR(integer*1,integer*1)')
- call c_i8(IEOR(m,m2),ma,'IEOR(integer*8,integer*8)')
+ call c_i2(IEOR(j,j2),ja,'IEOR(integer(2),integer(2))')
+ call c_i1(IEOR(k,k2),ka,'IEOR(integer(1),integer(1))')
+ call c_i8(IEOR(m,m2),ma,'IEOR(integer(8),integer(8))')
c ISHFT - Section 13.13.49
i = 3
call c_i(ISHFT(i,BIT_SIZE(i)),i3,'ISHFT(integer,integer) 2')
call c_i(ISHFT(i,-BIT_SIZE(i)),i3,'ISHFT(integer,integer) 3')
call c_i(ISHFT(i,0),i,'ISHFT(integer,integer) 4')
- call c_i2(ISHFT(j,j2),ja,'ISHFT(integer*2,integer*2)')
+ call c_i2(ISHFT(j,j2),ja,'ISHFT(integer(2),integer(2))')
call c_i2(ISHFT(j,BIT_SIZE(j)),j3,
- $ 'ISHFT(integer*2,integer*2) 2')
+ $ 'ISHFT(integer(2),integer(2)) 2')
call c_i2(ISHFT(j,-BIT_SIZE(j)),j3,
- $ 'ISHFT(integer*2,integer*2) 3')
- call c_i2(ISHFT(j,0),j,'ISHFT(integer*2,integer*2) 4')
- call c_i1(ISHFT(k,k2),ka,'ISHFT(integer*1,integer*1)')
+ $ 'ISHFT(integer(2),integer(2)) 3')
+ call c_i2(ISHFT(j,0),j,'ISHFT(integer(2),integer(2)) 4')
+ call c_i1(ISHFT(k,k2),ka,'ISHFT(integer(1),integer(1))')
call c_i1(ISHFT(k,BIT_SIZE(k)),k3,
- $ 'ISHFT(integer*1,integer*1) 2')
+ $ 'ISHFT(integer(1),integer(1)) 2')
call c_i1(ISHFT(k,-BIT_SIZE(k)),k3,
- $ 'ISHFT(integer*1,integer*1) 3')
- call c_i1(ISHFT(k,0),k,'ISHFT(integer*1,integer*1) 4')
- call c_i8(ISHFT(m,m2),ma,'ISHFT(integer*8,integer*8)')
+ $ 'ISHFT(integer(1),integer(1)) 3')
+ call c_i1(ISHFT(k,0),k,'ISHFT(integer(1),integer(1)) 4')
+ call c_i8(ISHFT(m,m2),ma,'ISHFT(integer(8),integer(8))')
call c_i8(ISHFT(m,BIT_SIZE(m)),m3,
- $ 'ISHFT(integer*8,integer*8) 2')
+ $ 'ISHFT(integer(8),integer(8)) 2')
call c_i8(ISHFT(m,-BIT_SIZE(m)),m3,
- $ 'ISHFT(integer*8,integer*8) 3')
- call c_i8(ISHFT(m,0),m,'ISHFT(integer*8,integer*8) 4')
+ $ 'ISHFT(integer(8),integer(8)) 3')
+ call c_i8(ISHFT(m,0),m,'ISHFT(integer(8),integer(8)) 4')
c ISHFTC - Section 13.13.50
c The third argument is not optional in g77
ma = 5
c test all the combinations of arguments
call c_i(ISHFTC(i,i2,i3),5,'ISHFTC(integer,integer,integer)')
- call c_i(ISHFTC(i,i2,j3),5,'ISHFTC(integer,integer,integer*2)')
- call c_i(ISHFTC(i,i2,k3),5,'ISHFTC(integer,integer,integer*1)')
- call c_i(ISHFTC(i,i2,m3),5,'ISHFTC(integer,integer,integer*8)')
- call c_i(ISHFTC(i,j2,i3),5,'ISHFTC(integer,integer*2,integer)')
- call c_i(ISHFTC(i,j2,j3),5,'ISHFTC(integer,integer*2,integer*2)')
- call c_i(ISHFTC(i,j2,k3),5,'ISHFTC(integer,integer*2,integer*1)')
- call c_i(ISHFTC(i,j2,m3),5,'ISHFTC(integer,integer*2,integer*8)')
- call c_i(ISHFTC(i,k2,i3),5,'ISHFTC(integer,integer*1,integer)')
- call c_i(ISHFTC(i,k2,j3),5,'ISHFTC(integer,integer*1,integer*2)')
- call c_i(ISHFTC(i,k2,k3),5,'ISHFTC(integer,integer*1,integer*1)')
- call c_i(ISHFTC(i,k2,m3),5,'ISHFTC(integer,integer*1,integer*8)')
- call c_i(ISHFTC(i,m2,i3),5,'ISHFTC(integer,integer*8,integer)')
- call c_i(ISHFTC(i,m2,j3),5,'ISHFTC(integer,integer*8,integer*2)')
- call c_i(ISHFTC(i,m2,k3),5,'ISHFTC(integer,integer*8,integer*1)')
- call c_i(ISHFTC(i,m2,m3),5,'ISHFTC(integer,integer*8,integer*8)')
+ call c_i(ISHFTC(i,i2,j3),5,'ISHFTC(integer,integer,integer(2))')
+ call c_i(ISHFTC(i,i2,k3),5,'ISHFTC(integer,integer,integer(1))')
+ call c_i(ISHFTC(i,i2,m3),5,'ISHFTC(integer,integer,integer(8))')
+ call c_i(ISHFTC(i,j2,i3),5,'ISHFTC(integer,integer(2),integer)')
+ call c_i(ISHFTC(i,j2,j3),5,
+ & 'ISHFTC(integer,integer(2),integer(2))')
+ call c_i(ISHFTC(i,j2,k3),5,
+ & 'ISHFTC(integer,integer(2),integer(1))')
+ call c_i(ISHFTC(i,j2,m3),5,
+ & 'ISHFTC(integer,integer(2),integer(8))')
+ call c_i(ISHFTC(i,k2,i3),5,'ISHFTC(integer,integer(1),integer)')
+ call c_i(ISHFTC(i,k2,j3),5,
+ & 'ISHFTC(integer,integer(1),integer(2))')
+ call c_i(ISHFTC(i,k2,k3),5,
+ & 'ISHFTC(integer,integer(1),integer(1))')
+ call c_i(ISHFTC(i,k2,m3),5,
+ & 'ISHFTC(integer,integer(1),integer(8))')
+ call c_i(ISHFTC(i,m2,i3),5,'ISHFTC(integer,integer(8),integer)')
+ call c_i(ISHFTC(i,m2,j3),5,
+ & 'ISHFTC(integer,integer(8),integer(2))')
+ call c_i(ISHFTC(i,m2,k3),5,
+ & 'ISHFTC(integer,integer(8),integer(1))')
+ call c_i(ISHFTC(i,m2,m3),5,
+ & 'ISHFTC(integer,integer(8),integer(8))')
- call c_i2(ISHFTC(j,i2,i3),ja,'ISHFTC(integer*2,integer,integer)')
+ call c_i2(ISHFTC(j,i2,i3),ja,'ISHFTC(integer(2),integer,integer)')
call c_i2(ISHFTC(j,i2,j3),ja,
- $ 'ISHFTC(integer*2,integer,integer*2)')
+ $ 'ISHFTC(integer(2),integer,integer(2))')
call c_i2(ISHFTC(j,i2,k3),ja,
- $ 'ISHFTC(integer*2,integer,integer*1)')
+ $ 'ISHFTC(integer(2),integer,integer(1))')
call c_i2(ISHFTC(j,i2,m3),ja,
- $ 'ISHFTC(integer*2,integer,integer*8)')
+ $ 'ISHFTC(integer(2),integer,integer(8))')
call c_i2(ISHFTC(j,j2,i3),ja,
- $ 'ISHFTC(integer*2,integer*2,integer)')
+ $ 'ISHFTC(integer(2),integer(2),integer)')
call c_i2(ISHFTC(j,j2,j3),ja,
- $ 'ISHFTC(integer*2,integer*2,integer*2)')
+ $ 'ISHFTC(integer(2),integer(2),integer(2))')
call c_i2(ISHFTC(j,j2,k3),ja,
- $ 'ISHFTC(integer*2,integer*2,integer*1)')
+ $ 'ISHFTC(integer(2),integer(2),integer(1))')
call c_i2(ISHFTC(j,j2,m3),ja,
- $ 'ISHFTC(integer*2,integer*2,integer*8)')
+ $ 'ISHFTC(integer(2),integer(2),integer(8))')
call c_i2(ISHFTC(j,k2,i3),ja,
- $ 'ISHFTC(integer*2,integer*1,integer)')
+ $ 'ISHFTC(integer(2),integer(1),integer)')
call c_i2(ISHFTC(j,k2,j3),ja,
- $ 'ISHFTC(integer*2,integer*1,integer*2)')
+ $ 'ISHFTC(integer(2),integer(1),integer(2))')
call c_i2(ISHFTC(j,k2,k3),ja,
- $ 'ISHFTC(integer*2,integer*1,integer*1)')
+ $ 'ISHFTC(integer(2),integer(1),integer(1))')
call c_i2(ISHFTC(j,k2,m3),ja,
- $ 'ISHFTC(integer*2,integer*1,integer*8)')
+ $ 'ISHFTC(integer(2),integer(1),integer(8))')
call c_i2(ISHFTC(j,m2,i3),ja,
- $ 'ISHFTC(integer*2,integer*8,integer)')
+ $ 'ISHFTC(integer(2),integer(8),integer)')
call c_i2(ISHFTC(j,m2,j3),ja,
- $ 'ISHFTC(integer*2,integer*8,integer*2)')
+ $ 'ISHFTC(integer(2),integer(8),integer(2))')
call c_i2(ISHFTC(j,m2,k3),ja,
- $ 'ISHFTC(integer*2,integer*8,integer*1)')
+ $ 'ISHFTC(integer(2),integer(8),integer(1))')
call c_i2(ISHFTC(j,m2,m3),ja,
- $ 'ISHFTC(integer*2,integer*8,integer*8)')
+ $ 'ISHFTC(integer(2),integer(8),integer(8))')
- call c_i1(ISHFTC(k,i2,i3),ka,'ISHFTC(integer*1,integer,integer)')
+ call c_i1(ISHFTC(k,i2,i3),ka,'ISHFTC(integer(1),integer,integer)')
call c_i1(ISHFTC(k,i2,j3),ka,
- $ 'ISHFTC(integer*1,integer,integer*2)')
+ $ 'ISHFTC(integer(1),integer,integer(2))')
call c_i1(ISHFTC(k,i2,k3),ka,
- $ 'ISHFTC(integer*1,integer,integer*1)')
+ $ 'ISHFTC(integer(1),integer,integer(1))')
call c_i1(ISHFTC(k,i2,m3),ka,
- $ 'ISHFTC(integer*1,integer,integer*8)')
+ $ 'ISHFTC(integer(1),integer,integer(8))')
call c_i1(ISHFTC(k,j2,i3),ka,
- $ 'ISHFTC(integer*1,integer*2,integer)')
+ $ 'ISHFTC(integer(1),integer(2),integer)')
call c_i1(ISHFTC(k,j2,j3),ka,
- $ 'ISHFTC(integer*1,integer*2,integer*2)')
+ $ 'ISHFTC(integer(1),integer(2),integer(2))')
call c_i1(ISHFTC(k,j2,k3),ka,
- $ 'ISHFTC(integer*1,integer*2,integer*1)')
+ $ 'ISHFTC(integer(1),integer(2),integer(1))')
call c_i1(ISHFTC(k,j2,m3),ka,
- $ 'ISHFTC(integer*1,integer*2,integer*8)')
+ $ 'ISHFTC(integer(1),integer(2),integer(8))')
call c_i1(ISHFTC(k,k2,i3),ka,
- $ 'ISHFTC(integer*1,integer*1,integer)')
+ $ 'ISHFTC(integer(1),integer(1),integer)')
call c_i1(ISHFTC(k,k2,j3),ka,
- $ 'ISHFTC(integer*1,integer*1,integer*2)')
+ $ 'ISHFTC(integer(1),integer(1),integer(2))')
call c_i1(ISHFTC(k,k2,k3),ka,
- $ 'ISHFTC(integer*1,integer*1,integer*1)')
+ $ 'ISHFTC(integer(1),integer(1),integer(1))')
call c_i1(ISHFTC(k,k2,m3),ka,
- $ 'ISHFTC(integer*1,integer*1,integer*8)')
+ $ 'ISHFTC(integer(1),integer(1),integer(8))')
call c_i1(ISHFTC(k,m2,i3),ka,
- $ 'ISHFTC(integer*1,integer*8,integer)')
+ $ 'ISHFTC(integer(1),integer(8),integer)')
call c_i1(ISHFTC(k,m2,j3),ka,
- $ 'ISHFTC(integer*1,integer*8,integer*2)')
+ $ 'ISHFTC(integer(1),integer(8),integer(2))')
call c_i1(ISHFTC(k,m2,k3),ka,
- $ 'ISHFTC(integer*1,integer*8,integer*1)')
+ $ 'ISHFTC(integer(1),integer(8),integer(1))')
call c_i1(ISHFTC(k,m2,m3),ka,
- $ 'ISHFTC(integer*1,integer*8,integer*8)')
+ $ 'ISHFTC(integer(1),integer(8),integer(8))')
- call c_i8(ISHFTC(m,i2,i3),ma,'ISHFTC(integer*8,integer,integer)')
+ call c_i8(ISHFTC(m,i2,i3),ma,'ISHFTC(integer(8),integer,integer)')
call c_i8(ISHFTC(m,i2,j3),ma,
- $ 'ISHFTC(integer*8,integer,integer*2)')
+ $ 'ISHFTC(integer(8),integer,integer(2))')
call c_i8(ISHFTC(m,i2,k3),ma,
- $ 'ISHFTC(integer*8,integer,integer*1)')
+ $ 'ISHFTC(integer(8),integer,integer(1))')
call c_i8(ISHFTC(m,i2,m3),ma,
- $ 'ISHFTC(integer*8,integer,integer*8)')
+ $ 'ISHFTC(integer(8),integer,integer(8))')
call c_i8(ISHFTC(m,j2,i3),ma,
- $ 'ISHFTC(integer*8,integer*2,integer)')
+ $ 'ISHFTC(integer(8),integer(2),integer)')
call c_i8(ISHFTC(m,j2,j3),ma,
- $ 'ISHFTC(integer*8,integer*2,integer*2)')
+ $ 'ISHFTC(integer(8),integer(2),integer(2))')
call c_i8(ISHFTC(m,j2,k3),ma,
- $ 'ISHFTC(integer*8,integer*2,integer*1)')
+ $ 'ISHFTC(integer(8),integer(2),integer(1))')
call c_i8(ISHFTC(m,j2,m3),ma,
- $ 'ISHFTC(integer*8,integer*2,integer*8)')
+ $ 'ISHFTC(integer(8),integer(2),integer(8))')
call c_i8(ISHFTC(m,k2,i3),ma,
- $ 'ISHFTC(integer*8,integer*1,integer)')
+ $ 'ISHFTC(integer(8),integer(1),integer)')
call c_i8(ISHFTC(m,k2,j3),ma,
- $ 'ISHFTC(integer*1,integer*8,integer*2)')
+ $ 'ISHFTC(integer(1),integer(8),integer(2))')
call c_i8(ISHFTC(m,k2,k3),ma,
- $ 'ISHFTC(integer*1,integer*8,integer*1)')
+ $ 'ISHFTC(integer(1),integer(8),integer(1))')
call c_i8(ISHFTC(m,k2,m3),ma,
- $ 'ISHFTC(integer*1,integer*8,integer*8)')
+ $ 'ISHFTC(integer(1),integer(8),integer(8))')
call c_i8(ISHFTC(m,m2,i3),ma,
- $ 'ISHFTC(integer*8,integer*8,integer)')
+ $ 'ISHFTC(integer(8),integer(8),integer)')
call c_i8(ISHFTC(m,m2,j3),ma,
- $ 'ISHFTC(integer*8,integer*8,integer*2)')
+ $ 'ISHFTC(integer(8),integer(8),integer(2))')
call c_i8(ISHFTC(m,m2,k3),ma,
- $ 'ISHFTC(integer*8,integer*8,integer*1)')
+ $ 'ISHFTC(integer(8),integer(8),integer(1))')
call c_i8(ISHFTC(m,m2,m3),ma,
- $ 'ISHFTC(integer*8,integer*8,integer*8)')
+ $ 'ISHFTC(integer(8),integer(8),integer(8))')
c test the corner cases
call c_i(ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)),i,
call c_i(ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)),i,
$ 'ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)) i = integer')
call c_i2(ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)),j,
- $ 'ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)) j = integer*2')
+ $ 'ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)) j = integer(2)')
call c_i2(ISHFTC(j,0,BIT_SIZE(j)),j,
- $ 'ISHFTC(j,0,BIT_SIZE(j)) j = integer*2')
+ $ 'ISHFTC(j,0,BIT_SIZE(j)) j = integer(2)')
call c_i2(ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)),j,
- $ 'ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)) j = integer*2')
+ $ 'ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)) j = integer(2)')
call c_i1(ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)),k,
- $ 'ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)) k = integer*1')
+ $ 'ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)) k = integer(1)')
call c_i1(ISHFTC(k,0,BIT_SIZE(k)),k,
- $ 'ISHFTC(k,0,BIT_SIZE(k)) k = integer*1')
+ $ 'ISHFTC(k,0,BIT_SIZE(k)) k = integer(1)')
call c_i1(ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)),k,
- $ 'ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)) k = integer*1')
+ $ 'ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)) k = integer(1)')
call c_i8(ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)),m,
- $ 'ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)) m = integer*8')
+ $ 'ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)) m = integer(8)')
call c_i8(ISHFTC(m,0,BIT_SIZE(m)),m,
- $ 'ISHFTC(m,0,BIT_SIZE(m)) m = integer*8')
+ $ 'ISHFTC(m,0,BIT_SIZE(m)) m = integer(8)')
call c_i8(ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)),m,
- $ 'ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)) m = integer*8')
+ $ 'ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)) m = integer(8)')
c MVBITS - Section 13.13.74
i = 6
m2 = 31
ma = 10
call c_i(IAND(NOT(21),31),10,'NOT(integer)')
- call c_i2(IAND(NOT(j),j2),ja,'NOT(integer*2)')
- call c_i1(IAND(NOT(k),k2),ka,'NOT(integer*1)')
- call c_i8(IAND(NOT(m),m2),ma,'NOT(integer*8)')
+ call c_i2(IAND(NOT(j),j2),ja,'NOT(integer(2))')
+ call c_i1(IAND(NOT(k),k2),ka,'NOT(integer(1))')
+ call c_i8(IAND(NOT(m),m2),ma,'NOT(integer(8))')
if ( fail ) call abort()
end
end
subroutine c_i2(i,j,label)
-c Check if INTEGER*2 i equals j, and fail otherwise
- integer*2 i,j
+c Check if INTEGER(kind=2) i equals j, and fail otherwise
+ integer(kind=2) i,j
character*(*) label
if ( i .ne. j ) then
call failure(label)
end
subroutine c_i1(i,j,label)
-c Check if INTEGER*1 i equals j, and fail otherwise
- integer*1 i,j
+c Check if INTEGER(kind=1) i equals j, and fail otherwise
+ integer(kind=1) i,j
character*(*) label
if ( i .ne. j ) then
call failure(label)
end
subroutine c_i8(i,j,label)
-c Check if INTEGER*8 i equals j, and fail otherwise
- integer*8 i,j
+c Check if INTEGER(kind=8) i equals j, and fail otherwise
+ integer(kind=8) i,j
character*(*) label
if ( i .ne. j ) then
call failure(label)
c intrinsic77.f
logical fail
- integer*2 j, j2, ja
- integer*1 k, k2, ka
+ integer(kind=2) j, j2, ja
+ integer(kind=1) k, k2, ka
common /flags/ fail
fail = .false.
k = j
ka = ja
call c_i(ABS(-7),7,'ABS(integer)')
- call c_i2(ABS(j),ja,'ABS(integer*2)')
- call c_i1(ABS(k),ka,'ABS(integer*1)')
+ call c_i2(ABS(j),ja,'ABS(integer(2))')
+ call c_i1(ABS(k),ka,'ABS(integer(1))')
call c_r(ABS(-7.),7.,'ABS(real)')
call c_d(ABS(-7.d0),7.d0,'ABS(double)')
call c_r(ABS((3.,-4.)),5.0,'ABS(complex)')
- call c_d(ABS((3.d0,-4.d0)),5.0d0,'ABS(double complex)')
+ call c_d(ABS((3.d0,-4.d0)),5.0d0,'ABS(complex(kind=8))')
c AIMAG - Section 13.13.6
call c_r(AIMAG((2.,-7.)),-7.,'AIMAG(complex)')
-c g77: AIMAG(double complex) does not comply with F90
-c call c_d(AIMAG((2.d0,-7.d0)),-7.d0,'AIMAG(double complex)')
+c g77: AIMAG(complex(kind=8)) does not comply with F90
+c call c_d(AIMAG((2.d0,-7.d0)),-7.d0,'AIMAG(complex(kind=8))')
c AINT - Section 13.13.7
call c_r(AINT(2.783),2.0,'AINT(real) 1')
ka = 2
call c_c(CMPLX(1),(1.,0.),'CMPLX(integer)')
call c_c(CMPLX(1,2),(1.,2.),'CMPLX(integer, integer)')
- call c_c(CMPLX(j),(1.,0.),'CMPLX(integer*2)')
- call c_c(CMPLX(j,ja),(1.,2.),'CMPLX(integer*2, integer*2)')
- call c_c(CMPLX(k),(1.,0.),'CMPLX(integer*1)')
- call c_c(CMPLX(k,ka),(1.,2.),'CMPLX(integer*1, integer*1)')
+ call c_c(CMPLX(j),(1.,0.),'CMPLX(integer(2))')
+ call c_c(CMPLX(j,ja),(1.,2.),'CMPLX(integer(2), integer(2))')
+ call c_c(CMPLX(k),(1.,0.),'CMPLX(integer(1)')
+ call c_c(CMPLX(k,ka),(1.,2.),'CMPLX(integer(1), integer(1))')
call c_c(CMPLX(1.),(1.,0.),'CMPLX(real)')
call c_c(CMPLX(1.d0),(1.,0.),'CMPLX(double)')
call c_c(CMPLX(1.d0,2.d0),(1.,2.),'CMPLX(double,double)')
call c_c(CMPLX(1.,2.),(1.,2.),'CMPLX(complex)')
- call c_c(CMPLX(1.d0,2.d0),(1.,2.),'CMPLX(double complex)')
+ call c_c(CMPLX(1.d0,2.d0),(1.,2.),'CMPLX(complex(kind=8))')
c NOTE: g77 does not support optional argument KIND
c CONJG - Section 13.13.21
call c_c(CONJG((2.,-7.)),(2.,7.),'CONJG(complex)')
- call c_z(CONJG((2.d0,-7.d0)),(2.d0,7.d0),'CONJG(double complex)')
+ call c_z(CONJG((2.d0,-7.d0)),(2.d0,7.d0),'CONJG(complex(kind=8))')
c DBLE - Section 13.13.27
j = 5
k = 5
call c_d(DBLE(5),5.0d0,'DBLE(integer)')
- call c_d(DBLE(j),5.0d0,'DBLE(integer*2)')
- call c_d(DBLE(k),5.0d0,'DBLE(integer*1)')
+ call c_d(DBLE(j),5.0d0,'DBLE(integer(2))')
+ call c_d(DBLE(k),5.0d0,'DBLE(integer(1))')
call c_d(DBLE(5.),5.0d0,'DBLE(real)')
call c_d(DBLE(5.0d0),5.0d0,'DBLE(double)')
call c_d(DBLE((5.0,0.5)),5.0d0,'DBLE(complex)')
- call c_d(DBLE((5.0d0,0.5d0)),5.0d0,'DBLE(double complex)')
+ call c_d(DBLE((5.0d0,0.5d0)),5.0d0,'DBLE(complex(kind=8))')
c DIM - Section 13.13.29
j = -8
k2 = -3
ka = 0
call c_i(DIM(-8,-3),0,'DIM(integer)')
- call c_i2(DIM(j,j2),ja,'DIM(integer*2)')
- call c_i1(DIM(k,k2),ka,'DIM(integer*1)')
+ call c_i2(DIM(j,j2),ja,'DIM(integer(2))')
+ call c_i1(DIM(k,k2),ka,'DIM(integer(1)')
call c_r(DIM(-8.,-3.),0.,'DIM(real,real)')
call c_d(DIM(-8.d0,-3.d0),0.d0,'DIM(double,double)')
j = 5
k = 5
call c_i(INT(5),5,'INT(integer)')
- call c_i(INT(j),5,'INT(integer*2)')
- call c_i(INT(k),5,'INT(integer*1)')
+ call c_i(INT(j),5,'INT(integer(2))')
+ call c_i(INT(k),5,'INT(integer(1))')
call c_i(INT(5.01),5,'INT(real)')
call c_i(INT(5.01d0),5,'INT(double)')
c Note: Does not accept optional second argument KIND
k2 = 2
ka = 2
call c_i(MAX(1,2,3),3,'MAX(integer,integer,integer)')
- call c_i2(MAX(j,j2),ja,'MAX(integer*2,integer*2)')
- call c_i1(MAX(k,k2),ka,'MAX(integer*1,integer*1)')
+ call c_i2(MAX(j,j2),ja,'MAX(integer(2),integer(2))')
+ call c_i1(MAX(k,k2),ka,'MAX(integer(1),integer(1))')
call c_r(MAX(1.,2.,3.),3.,'MAX(real,real,real)')
call c_d(MAX(1.d0,2.d0,3.d0),3.d0,'MAX(double,double,double)')
k2 = 2
ka = 1
call c_i(MIN(1,2,3),1,'MIN(integer,integer,integer)')
- call c_i2(MIN(j,j2),ja,'MIN(integer*2,integer*2)')
- call c_i1(MIN(k,k2),ka,'MIN(integer*1,integer*1)')
+ call c_i2(MIN(j,j2),ja,'MIN(integer(2),integer(2))')
+ call c_i1(MIN(k,k2),ka,'MIN(integer(1),integer(1))')
call c_r(MIN(1.,2.,3.),1.,'MIN(real,real,real)')
call c_d(MIN(1.d0,2.d0,3.d0),1.d0,'MIN(double,double,double)')
j = 8
j2 = 5
ja = 3
- call c_i2(MOD(j,j2),ja,'MOD(integer*2,integer*2) 1')
- call c_i2(MOD(-j,j2),-ja,'MOD(integer*2,integer*2) 2')
- call c_i2(MOD(j,-j2),ja,'MOD(integer*2,integer*2) 3')
- call c_i2(MOD(-j,-j2),-ja,'MOD(integer*2,integer*2) 4')
+ call c_i2(MOD(j,j2),ja,'MOD(integer(2),integer(2)) 1')
+ call c_i2(MOD(-j,j2),-ja,'MOD(integer(2),integer(2)) 2')
+ call c_i2(MOD(j,-j2),ja,'MOD(integer(2),integer(2)) 3')
+ call c_i2(MOD(-j,-j2),-ja,'MOD(integer(2),integer(2)) 4')
k = 8
k2 = 5
ka = 3
- call c_i1(MOD(k,k2),ka,'MOD(integer*1,integer*1) 1')
- call c_i1(MOD(-k,k2),-ka,'MOD(integer*1,integer*1) 2')
- call c_i1(MOD(k,-k2),ka,'MOD(integer*1,integer*1) 3')
- call c_i1(MOD(-k,-k2),-ka,'MOD(integer*1,integer*1) 4')
+ call c_i1(MOD(k,k2),ka,'MOD(integer(1),integer(1)) 1')
+ call c_i1(MOD(-k,k2),-ka,'MOD(integer(1),integer(1)) 2')
+ call c_i1(MOD(k,-k2),ka,'MOD(integer(1),integer(1)) 3')
+ call c_i1(MOD(-k,-k2),-ka,'MOD(integer(1),integer(1)) 4')
call c_r(MOD(8.,5.),3.,'MOD(real,real) 1')
call c_r(MOD(-8.,5.),-3.,'MOD(real,real) 2')
call c_r(MOD(8.,-5.),3.,'MOD(real,real) 3')
j = -2
k = -2
call c_r(REAL(-2),-2.0,'REAL(integer)')
- call c_r(REAL(j),-2.0,'REAL(integer*2)')
- call c_r(REAL(k),-2.0,'REAL(integer*1)')
+ call c_r(REAL(j),-2.0,'REAL(integer(2))')
+ call c_r(REAL(k),-2.0,'REAL(integer(1))')
call c_r(REAL(-2.0),-2.0,'REAL(real)')
call c_r(REAL(-2.0d0),-2.0,'REAL(double)')
call c_r(REAL((-2.,9.)),-2.0,'REAL(complex)')
-c REAL(double complex) not implemented
-c call c_r(REAL((-2.d0,9.d0)),-2.0,'REAL(double complex)')
+c REAL(complex(kind=8)) not implemented
+c call c_r(REAL((-2.d0,9.d0)),-2.0,'REAL(complex(kind=8))')
c SIGN - Section 13.13.96
j = -3
k2 = 2
ka = 3
call c_i(SIGN(-3,2),3,'SIGN(integer)')
- call c_i2(SIGN(j,j2),ja,'SIGN(integer*2)')
- call c_i1(SIGN(k,k2),ka,'SIGN(integer*1)')
+ call c_i2(SIGN(j,j2),ja,'SIGN(integer(2))')
+ call c_i1(SIGN(k,k2),ka,'SIGN(integer(1))')
call c_r(SIGN(-3.0,2.),3.,'SIGN(real,real)')
call c_d(SIGN(-3.d0,2.d0),3.d0,'SIGN(double,double)')
end
subroutine c_i2(i,j,label)
-c Check if INTEGER*2 i equals j, and fail otherwise
- integer*2 i,j
+c Check if INTEGER(kind=2) i equals j, and fail otherwise
+ integer(kind=2) i,j
character*(*) label
if ( i .ne. j ) then
call failure(label)
end
subroutine c_i1(i,j,label)
-c Check if INTEGER*1 i equals j, and fail otherwise
- integer*1 i,j
+c Check if INTEGER(kind=1) i equals j, and fail otherwise
+ integer(kind=1) i,j
character*(*) label
if ( i .ne. j ) then
call failure(label)
subroutine c_z(a,b,label)
c Check if COMPLEX a equals b, and fail otherwise
- double complex a, b
+ complex(kind=8) a, b
character*(*) label
if ( abs(a-b) .gt. 1.0d-5 ) then
call failure(label)