Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
Timestamp:
Mar 20, 2014 8:40:49 AM (10 years ago)
Author:
raasch
Message:

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/temperton_fft.f90

    r392 r1320  
    44! Current revisions:
    55! -----------------
    6 !
     6! ONLY-attribute added to USE-statements,
     7! kind-parameters added to all INTEGER and REAL declaration statements,
     8! kinds are defined in new module kinds,
     9! old module precision_kind is removed,
     10! revision history before 2012 removed,
     11! comment fields (!:) to be used for variable explanations added to
     12! all variable declaration statements
    713!
    814! Former revisions:
    915! -----------------
    1016! $Id$
    11 !
    12 ! 258 2009-03-13 12:36:03Z heinze
    13 ! Output of messages replaced by message handling routine.
    14 !
    15 ! Feb. 2007
    16 ! RCS Log replace by Id keyword, revision history cleaned up
    17 !
    18 ! Revision 1.2  2003/04/16 12:49:25  raasch
    19 ! Abort in case of illegal factors
    2017!
    2118! Revision 1.1  2003/03/12 16:41:59  raasch
    … …  
    2825!------------------------------------------------------------------------------!
    2926
     27    USE kinds
     28
    3029    IMPLICIT NONE
    3130
    … …  
    3534
    3635
    37     INTEGER           ::  nfax(10)   ! array used by *fft991*.
    38     REAL, ALLOCATABLE ::  trig(:)    ! array used by *fft991*.
     36    INTEGER(iwp)          ::  nfax(10)   !: array used by *fft991*.
     37    REAL(wp), ALLOCATABLE ::  trig(:)    !: array used by *fft991*.
    3938
    4039!
    4140!-- nfft: maximum length of calls to *fft.
    4241#if defined( __nec )
    43     INTEGER, PARAMETER ::  nfft = 256
     42    INTEGER(iwp), PARAMETER ::  nfft = 256  !:
    4443#else
    45     INTEGER, PARAMETER ::  nfft =  32
     44    INTEGER(iwp), PARAMETER ::  nfft =  32  !:
    4645#endif
    4746
    48     INTEGER, PARAMETER ::  nout =   6  ! standard output stream
     47    INTEGER(iwp), PARAMETER ::  nout =   6  !: standard output stream
    4948
    5049CONTAINS
    … …  
    9998    ! dimension a(n),work(n),trigs(n),ifax(1)
    10099
     100    USE kinds
    101101
    102102    IMPLICIT NONE
    103103
    104104    !  Scalar arguments
    105     INTEGER :: inc, isign, jump, lot, n
     105    INTEGER(iwp) ::  inc   !:
     106    INTEGER(iwp) ::  isign !:
     107    INTEGER(iwp) ::  jump  !:
     108    INTEGER(iwp) ::  lot   !:
     109    INTEGER(iwp) ::  n     !:
    106110
    107111    !  Array arguments
    108     REAL :: a(*), trigs(*), work(*)
    109     INTEGER :: ifax(*)
     112    REAL(wp)     ::  a(*)     !:
     113    REAL(wp)     ::  trigs(*) !:
     114    REAL(wp)     ::  work(*)  !:
     115    INTEGER(iwp) ::  ifax(*)  !:
    110116
    111117    !  Local scalars:
    112     INTEGER :: i, ia, ibase, ierr, ifac, igo, ii, istart, ix, iz, j, jbase, jj, &
    113          &      k, la, nb, nblox, nfax, nvex, nx
     118    INTEGER(iwp) ::  i      !:
     119    INTEGER(iwp) ::  ia     !:
     120    INTEGER(iwp) ::  ibase  !:
     121    INTEGER(iwp) ::  ierr   !:
     122    INTEGER(iwp) ::  ifac   !:
     123    INTEGER(iwp) ::  igo    !:
     124    INTEGER(iwp) ::  ii     !:
     125    INTEGER(iwp) ::  istart !:
     126    INTEGER(iwp) ::  ix     !:
     127    INTEGER(iwp) ::  iz     !:
     128    INTEGER(iwp) ::  j      !:
     129    INTEGER(iwp) ::  jbase  !:
     130    INTEGER(iwp) ::  jj     !:
     131    INTEGER(iwp) ::  k      !:
     132    INTEGER(iwp) ::  la     !:
     133    INTEGER(iwp) ::  nb     !:
     134    INTEGER(iwp) ::  nblox  !:
     135    INTEGER(iwp) ::  nfax   !:
     136    INTEGER(iwp) ::  nvex   !:
     137    INTEGER(iwp) ::  nx     !:
    114138
    115139    !  Intrinsic functions
    116     INTRINSIC MOD
     140!    INTRINSIC MOD
    117141
    118142
    … …  
    316340    !
    317341
    318     IMPLICIT NONE
     342    USE kinds
     343
     344    IMPLICIT NONE
    319345
    320346    !  Scalar arguments
    321     INTEGER :: ierr, ifac, inc1, inc2, inc3, inc4, la, lot, n
     347    INTEGER(iwp) ::  ierr !:
     348    INTEGER(iwp) ::  ifac !:
     349    INTEGER(iwp) ::  inc1 !:
     350    INTEGER(iwp) ::  inc2 !:
     351    INTEGER(iwp) ::  inc3 !:
     352    INTEGER(iwp) ::  inc4 !:
     353    INTEGER(iwp) ::  la   !:
     354    INTEGER(iwp) ::  lot  !:
     355    INTEGER(iwp) ::  n    !:
    322356
    323357    !  Array arguments
    324358    ! REAL :: a(n),b(n),c(n),d(n),trigs(n)
    325     REAL :: a(*), b(*), c(*), d(*), trigs(*)
    326 
     359    REAL(wp) ::  a(*)     !:
     360    REAL(wp) ::  b(*)     !:
     361    REAL(wp) ::  c(*)     !:
     362    REAL(wp) ::  d(*)     !:
     363    REAL(wp) ::  trigs(*) !:
     364 
    327365    !  Local scalars:
    328     REAL :: a0, a1, a10, a11, a2, a20, a21, a3, a4, a5, a6, b0, b1, b10, b11, &
    329          &      b2, b20, b21, b3, b4, b5, b6, c1, c2, c3, c4, c5, qrt5, s1, s2, s3, s4, &
    330          &      s5, sin36, sin45, sin60, sin72, z, zqrt5, zsin36, zsin45, zsin60, &
    331          &      zsin72
    332     INTEGER :: i, ia, ib, ibad, ibase, ic, id, ie, if, ig, igo, ih, iink, ijk, &
    333          &      ijump, j, ja, jb, jbase, jc, jd, je, jf, jink, k, kb, kc, kd, ke, kf, &
    334          &      kstop, l, m
     366    REAL(wp) ::  a0     !:
     367    REAL(wp) ::  a1     !:
     368    REAL(wp) ::  a10    !:
     369    REAL(wp) ::  a11    !:
     370    REAL(wp) ::  a2     !:
     371    REAL(wp) ::  a20    !:
     372    REAL(wp) ::  a21    !:
     373    REAL(wp) ::  a3     !:
     374    REAL(wp) ::  a4     !:
     375    REAL(wp) ::  a5     !:
     376    REAL(wp) ::  a6     !:
     377    REAL(wp) ::  b0     !:
     378    REAL(wp) ::  b1     !:
     379    REAL(wp) ::  b10    !:
     380    REAL(wp) ::  b11    !:
     381    REAL(wp) ::  b2     !:
     382    REAL(wp) ::  b20    !:
     383    REAL(wp) ::  b21    !:
     384    REAL(wp) ::  b3     !:
     385    REAL(wp) ::  b4     !:
     386    REAL(wp) ::  b5     !:
     387    REAL(wp) ::  b6     !:
     388    REAL(wp) ::  c1     !:
     389    REAL(wp) ::  c2     !:
     390    REAL(wp) ::  c3     !:
     391    REAL(wp) ::  c4     !:
     392    REAL(wp) ::  c5     !:
     393    REAL(wp) ::  qrt5   !:
     394    REAL(wp) ::  s1     !:
     395    REAL(wp) ::  s2     !:
     396    REAL(wp) ::  s3     !:
     397    REAL(wp) ::  s4     !:
     398    REAL(wp) ::  s5     !:
     399    REAL(wp) ::  sin36  !:
     400    REAL(wp) ::  sin45  !:
     401    REAL(wp) ::  sin60  !:
     402    REAL(wp) ::  sin72  !:
     403    REAL(wp) ::  z      !:
     404    REAL(wp) ::  zqrt5  !:
     405    REAL(wp) ::  zsin36 !:
     406    REAL(wp) ::  zsin45 !:
     407    REAL(wp) ::  zsin60 !:
     408    REAL(wp) ::  zsin72 !:
     409
     410    INTEGER(iwp) ::  i     !:
     411    INTEGER(iwp) ::  ia    !:
     412    INTEGER(iwp) ::  ib    !:
     413    INTEGER(iwp) ::  ibad  !:
     414    INTEGER(iwp) ::  ibase !:
     415    INTEGER(iwp) ::  ic    !:
     416    INTEGER(iwp) ::  id    !:
     417    INTEGER(iwp) ::  ie    !:
     418    INTEGER(iwp) ::  if    !:
     419    INTEGER(iwp) ::  ig    !:
     420    INTEGER(iwp) ::  igo   !:
     421    INTEGER(iwp) ::  ih    !:
     422    INTEGER(iwp) ::  iink  !:
     423    INTEGER(iwp) ::  ijk   !:
     424    INTEGER(iwp) ::  ijump !:
     425    INTEGER(iwp) ::  j     !:
     426    INTEGER(iwp) ::  ja    !:
     427    INTEGER(iwp) ::  jb    !:
     428    INTEGER(iwp) ::  jbase !:
     429    INTEGER(iwp) ::  jc    !:
     430    INTEGER(iwp) ::  jd    !:
     431    INTEGER(iwp) ::  je    !:
     432    INTEGER(iwp) ::  jf    !:
     433    INTEGER(iwp) ::  jink  !:
     434    INTEGER(iwp) ::  k     !:
     435    INTEGER(iwp) ::  kb    !:
     436    INTEGER(iwp) ::  kc    !:
     437    INTEGER(iwp) ::  kd    !:
     438    INTEGER(iwp) ::  ke    !:
     439    INTEGER(iwp) ::  kf    !:
     440    INTEGER(iwp) ::  kstop !:
     441    INTEGER(iwp) ::  l     !:
     442    INTEGER(iwp) ::  m     !:
    335443
    336444    !  Intrinsic functions
    337     INTRINSIC REAL, SQRT
     445!    INTRINSIC REAL, SQRT
    338446
    339447    !  Data statements
    340     DATA sin36/0.587785252292473/, sin72/0.951056516295154/, &
    341          &      qrt5/0.559016994374947/, sin60/0.866025403784437/
     448    DATA sin36/0.587785252292473_wp/, sin72/0.951056516295154_wp/, &
     449         &      qrt5/0.559016994374947_wp/, sin60/0.866025403784437_wp/
    342450
    343451
    … …  
    438546    GO TO 170
    43954730  CONTINUE
    440     z = 1.0/REAL(n)
     548    z = 1.0_wp/REAL(n)
    441549    DO l = 1, la
    442550       i = ibase
    … …  
    551659    GO TO 170
    55266060  CONTINUE
    553     z = 1.0/REAL(n)
     661    z = 1.0_wp/REAL(n)
    554662    zsin60 = z*sin60
    555663    DO l = 1, la
    … …  
    658766    IF (jb>jc) GO TO 170
    65976780  CONTINUE
    660     sin45 = SQRT(0.5)
     768    sin45 = SQRT(0.5_wp)
    661769    jbase = 0
    662770    DO l = 1, la
    … …  
    680788    GO TO 170
    68178990  CONTINUE
    682     z = 1.0/REAL(n)
     790    z = 1.0_wp/REAL(n)
    683791    DO l = 1, la
    684792       i = ibase
    … …  
    843951    GO TO 170
    844952120 CONTINUE
    845     z = 1.0/REAL(n)
     953    z = 1.0_wp/REAL(n)
    846954    zqrt5 = z*qrt5
    847955    zsin36 = z*sin36
    … …  
    10191127    GO TO 170
    10201128150 CONTINUE
    1021     z = 1.0/REAL(n)
     1129    z = 1.0_wp/REAL(n)
    10221130    zsin60 = z*sin60
    10231131    DO l = 1, la
    … …  
    10621170    jd = jc + 2*m*inc2
    10631171    je = jd + 2*m*inc2
    1064     z = 1.0/REAL(n)
     1172    z = 1.0_wp/REAL(n)
    10651173    zsin45 = z*SQRT(0.5)
    10661174
    … …  
    11051213    ! Dimension a(n),b(n),c(n),d(n),trigs(n)
    11061214
     1215    USE kinds
     1216
    11071217    IMPLICIT NONE
    11081218
    11091219    !  Scalar arguments
    1110     INTEGER :: ierr, ifac, inc1, inc2, inc3, inc4, la, lot, n
     1220    INTEGER(iwp) ::  ierr !:
     1221    INTEGER(iwp) ::  ifac !:
     1222    INTEGER(iwp) ::  inc1 !:
     1223    INTEGER(iwp) ::  inc2 !:
     1224    INTEGER(iwp) ::  inc3 !:
     1225    INTEGER(iwp) ::  inc4 !:
     1226    INTEGER(iwp) ::  la   !:
     1227    INTEGER(iwp) ::  lot  !:
     1228    INTEGER(iwp) ::  n    !:
    11111229
    11121230    !  Array arguments
    1113     REAL :: a(*), b(*), c(*), d(*), trigs(*)
     1231    REAL(wp) ::  a(*)     !:
     1232    REAL(wp) ::  b(*)     !:
     1233    REAL(wp) ::  c(*)     !:
     1234    REAL(wp) ::  d(*)     !:
     1235    REAL(wp) ::  trigs(*) !:
    11141236
    11151237    !  Local scalars:
    1116     REAL :: c1, c2, c3, c4, c5, qqrt5, qrt5, s1, s2, s3, s4, s5, sin36, sin45, &
    1117          &      sin60, sin72, ssin36, ssin45, ssin60, ssin72
    1118     INTEGER :: i, ia, ib, ibad, ibase, ic, id, ie, if, igo, iink, ijk, j, ja, &
    1119          &      jb, jbase, jc, jd, je, jf, jg, jh, jink, jump, k, kb, kc, kd, ke, kf, &
    1120          &      kstop, l, m
     1238    REAL(wp) ::  c1     !:
     1239    REAL(wp) ::  c2     !:
     1240    REAL(wp) ::  c3     !:
     1241    REAL(wp) ::  c4     !:
     1242    REAL(wp) ::  c5     !:
     1243    REAL(wp) ::  qqrt5  !:
     1244    REAL(wp) ::  qrt5   !:
     1245    REAL(wp) ::  s1     !:
     1246    REAL(wp) ::  s2     !:
     1247    REAL(wp) ::  s3     !:
     1248    REAL(wp) ::  s4     !:
     1249    REAL(wp) ::  s5     !:
     1250    REAL(wp) ::  sin36  !:
     1251    REAL(wp) ::  sin45  !:
     1252    REAL(wp) ::  sin60  !:
     1253    REAL(wp) ::  sin72  !:
     1254    REAL(wp) ::  ssin36 !:
     1255    REAL(wp) ::  ssin45 !:
     1256    REAL(wp) ::  ssin60 !:
     1257    REAL(wp) ::  ssin72 !:
     1258
     1259    INTEGER(iwp) ::  i     !:
     1260    INTEGER(iwp) ::  ia    !:
     1261    INTEGER(iwp) ::  ib    !:
     1262    INTEGER(iwp) ::  ibad  !:
     1263    INTEGER(iwp) ::  ibase !:
     1264    INTEGER(iwp) ::  ic    !:
     1265    INTEGER(iwp) ::  id    !:
     1266    INTEGER(iwp) ::  ie    !:
     1267    INTEGER(iwp) ::  if    !:
     1268    INTEGER(iwp) ::  igo   !:
     1269    INTEGER(iwp) ::  iink  !:
     1270    INTEGER(iwp) ::  ijk   !:
     1271    INTEGER(iwp) ::  j     !:
     1272    INTEGER(iwp) ::  ja    !:
     1273    INTEGER(iwp) ::  jb    !:
     1274    INTEGER(iwp) ::  jbase !:
     1275    INTEGER(iwp) ::  jc    !:
     1276    INTEGER(iwp) ::  jd    !:
     1277    INTEGER(iwp) ::  je    !:
     1278    INTEGER(iwp) ::  jf    !:
     1279    INTEGER(iwp) ::  jg    !:
     1280    INTEGER(iwp) ::  jh    !:
     1281    INTEGER(iwp) ::  jink  !:
     1282    INTEGER(iwp) ::  jump  !:
     1283    INTEGER(iwp) ::  k     !:
     1284    INTEGER(iwp) ::  kb    !:
     1285    INTEGER(iwp) ::  kc    !:
     1286    INTEGER(iwp) ::  kd    !:
     1287    INTEGER(iwp) ::  ke    !:
     1288    INTEGER(iwp) ::  kf    !:
     1289    INTEGER(iwp) ::  kstop !:
     1290    INTEGER(iwp) ::  l     !:
     1291    INTEGER(iwp) ::  m     !:
    11211292
    11221293    !  Local arrays:
    1123     REAL :: a10(nfft), a11(nfft), a20(nfft), a21(nfft), b10(nfft), b11(nfft), b20(nfft), &
    1124          &      b21(nfft)
     1294    REAL(wp) ::  a10(nfft) !:
     1295    REAL(wp) ::  a11(nfft) !:
     1296    REAL(wp) ::  a20(nfft) !:
     1297    REAL(wp) ::  a21(nfft) !:
     1298    REAL(wp) ::  b10(nfft) !:
     1299    REAL(wp) ::  b11(nfft) !:
     1300    REAL(wp) ::  b20(nfft) !:
     1301    REAL(wp) ::  b21(nfft) !:
    11251302
    11261303    !  Intrinsic functions
    1127     INTRINSIC SQRT
     1304!    INTRINSIC SQRT
    11281305
    11291306    !  Data statements
    1130     DATA sin36/0.587785252292473/, sin72/0.951056516295154/, &
    1131          &      qrt5/0.559016994374947/, sin60/0.866025403784437/
     1307    DATA sin36/0.587785252292473_wp/, sin72/0.951056516295154_wp/, &
     1308         &      qrt5/0.559016994374947_wp/, sin60/0.866025403784437_wp/
    11321309
    11331310
    … …  
    16221799    GO TO 170
    16231800120 CONTINUE
    1624     qqrt5 = 2.0*qrt5
    1625     ssin36 = 2.0*sin36
    1626     ssin72 = 2.0*sin72
     1801    qqrt5 = 2.0_wp*qrt5
     1802    ssin36 = 2.0_wp*sin36
     1803    ssin72 = 2.0_wp*sin72
    16271804    DO l = 1, la
    16281805       i = ibase
    … …  
    18382015    jg = jf + jink
    18392016    jh = jg + jink
    1840     ssin45 = SQRT(2.0)
     2017    ssin45 = SQRT(2.0_wp)
    18412018
    18422019    DO l = 1, la
    … …  
    18892066
    18902067
    1891     USE control_parameters
    1892     USE pegrid
     2068    USE control_parameters,                                                    &
     2069        ONLY:  message_string
     2070
     2071    USE kinds
    18932072
    18942073    IMPLICIT NONE
    18952074
    18962075    !  Scalar arguments
    1897     INTEGER :: n
     2076    INTEGER(iwp) ::  n !:
    18982077
    18992078    !  Array arguments
    1900     REAL :: trigs(*)
    1901     INTEGER :: ifax(*)
     2079    INTEGER(iwp) ::  ifax(*)  !:
     2080    REAL(wp)     ::  trigs(*) !:
     2081
    19022082
    19032083    !  Local scalars:
    1904     REAL :: angle, del
    1905     INTEGER :: i, ifac, ixxx, k, l, nfax, nhl, nil, nu
     2084    REAL(wp) ::  angle    !:
     2085    REAL(wp) ::  del      !:
     2086    INTEGER(iwp) ::  i    !:
     2087    INTEGER(iwp) ::  ifac !:
     2088    INTEGER(iwp) ::  ixxx !:
     2089    INTEGER(iwp) ::  k    !:
     2090    INTEGER(iwp) ::  l    !:
     2091    INTEGER(iwp) ::  nfax !:
     2092    INTEGER(iwp) ::  nhl  !:
     2093    INTEGER(iwp) ::  nil  !:
     2094    INTEGER(iwp) ::  nu   !:
    19062095
    19072096    !  Local arrays:
    1908     INTEGER :: jfax(10), lfax(7)
     2097    INTEGER(iwp) ::  jfax(10) !:
     2098    INTEGER(iwp) ::  lfax(7)  !:
    19092099
    19102100    !  Intrinsic functions
    1911     INTRINSIC ASIN, COS, MOD, REAL, SIN
     2101!    INTRINSIC ASIN, COS, MOD, REAL, SIN
    19122102
    19132103    !  Data statements
    … …  
    19182108    ixxx = 1
    19192109
    1920     del = 4.0*ASIN(1.0)/REAL(n)
     2110    del = 4.0_wp*ASIN(1.0_wp)/REAL(n)
    19212111    nil = 0
    19222112    nhl = (n/2) - 1
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |