Ignore:
Timestamp:
Mar 5, 2014, 2:19:12 PM (11 years ago)
Author:
lguez
Message:

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/cv3_inip.F90

    r1988 r1992  
    1         SUBROUTINE cv3_inip()
    2 ***************************************************************
    3 *                                                             *
    4 * CV3_INIP Lecture des choix de lois de probabilité de mélange*
    5 *          et calcul de leurs coefficients normalisés.        *
    6 *                                                             *
    7 * written by   : Jean-Yves Grandpeix, 06/06/2006, 19.39.27    *
    8 * modified by :                                               *
    9 ***************************************************************
    10 *
    11 #include "YOMCST2.h"
    12 c
    13 c      INTEGER iflag_mix
    14       include 'iniprint.h'
     1SUBROUTINE cv3_inip()
     2  ! **************************************************************
     3  ! *
     4  ! CV3_INIP Lecture des choix de lois de probabilité de mélange*
     5  ! et calcul de leurs coefficients normalisés.        *
     6  ! *
     7  ! written by   : Jean-Yves Grandpeix, 06/06/2006, 19.39.27    *
     8  ! modified by :                                               *
     9  ! **************************************************************
    1510
    16       CHARACTER (LEN=20) :: modname='cv3_inip'
    17       CHARACTER (LEN=80) :: abort_message
     11  include "YOMCST2.h"
    1812
    19 c
    20 c --   Mixing probability distribution functions
    21 c
    22       real Qcoef1,Qcoef2,QFF,QFFF,Qmix,Rmix,Qmix1,Rmix1,Qmix2,Rmix2,F
    23       Qcoef1(F) = tanh(F/gammas)
    24       Qcoef2(F) = ( tanh(F/gammas) + gammas *
    25      $            log(cosh((1.- F)/gammas)/cosh(F/gammas)))
    26       QFF(F) = Max(Min(F,1.),0.)
    27       QFFF(F) = Min(QFF(F),scut)
    28       Qmix1(F) = ( tanh((QFF(F) - Fmax)/gammas)+Qcoef1max )/
    29      $           Qcoef2max
    30       Rmix1(F) = ( gammas*log(cosh((QFF(F)-Fmax)/gammas))
    31      1             +QFF(F)*Qcoef1max ) / Qcoef2max
    32       Qmix2(F) = -Log(1.-QFFF(F))/scut
    33       Rmix2(F) = (QFFF(F)+(1.-QFF(F))*Log(1.-QFFF(F)))/scut
    34       Qmix(F) = qqa1*Qmix1(F) + qqa2*Qmix2(F)
    35       Rmix(F) = qqa1*Rmix1(F) + qqa2*Rmix2(F)
    36 C
    37 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    38 c
    39 C
    40 C===========================================================================
    41 C       READ IN PARAMETERS FOR THE MIXING DISTRIBUTION
    42 C       AND PASS THESE THROUGH A COMMON BLOCK TO SUBROUTINE CONVECT etc.
    43 C       (Written by V.T.J. Phillips, 20-30/Jan/99)
    44 C===========================================================================
    45 C
    46 C   line 1:  a flag (0 or 1) to decide whether P(F) = 1 or the general P(F) is to be
    47 C         used, followed by SCUT, which is the cut-off value of F in CONVECT
    48 C   line 2:  blank
    49 C   line 3:  the coefficients for the linear combination of P(F)s to
    50 C                 make the general P(F)
    51 C   line 4:  blank
    52 C   line 5:  gammas, Fmax for the cosh^2 component of P(F)
    53 C   line 6:  blank
    54 C   line 7:  alphas for the 1st irrational P(F)
    55 C   line 8:  blank
    56 C   line 9:  betas  for the 2nd irrational P(F)
    57 C
     13  ! INTEGER iflag_mix
     14  include 'iniprint.h'
    5815
    59 cc$$$        open(57,file='parameter_mix.data')
    60 cc$$$
    61 cc$$$        read(57,*) iflag_mix, scut
    62 cc$$$        read(57,*)
    63 cc$$$        if(iflag_mix .gt. 0) then
    64 cc$$$         read(57,*) qqa1, qqa2
    65 cc$$$              read(57,*)
    66 cc$$$              read(57,*) gammas, Fmax
    67 cc$$$              read(57,*)
    68 cc$$$              read(57,*) alphas
    69 cc$$$         endif
    70 cc$$$    close(57)
     16  CHARACTER (LEN=20) :: modname = 'cv3_inip'
     17  CHARACTER (LEN=80) :: abort_message
    7118
    72 c
    73       if(iflag_mix .gt. 0) then
    74 c
    75 c--      Normalize Pdf weights
    76 c
    77         sumcoef=qqa1+qqa2
    78         qqa1=qqa1/sumcoef
    79         qqa2=qqa2/sumcoef
    80 c
    81         Qcoef1max = Qcoef1(Fmax)
    82         Qcoef2max = Qcoef2(Fmax)
    83 c
    84         sigma = 0.
    85         aire=0.0
    86         pdf=0.0
    87         mu=0.0
    88         df = 0.0001
    89 c
    90 c        do ff = 0.0 + df, 1.0 - 2.*df, df
    91          ff=df
    92          dowhile ( ff .le. 1.0 - 2.*df )
    93               pdf = (Qmix(ff+df) -  Qmix(ff)) * (1.-ff) / df
    94               aire=aire+(Qmix(ff+df) - Qmix(ff)) * (1.-ff)
    95               mu = mu + pdf * ff * df
    96          IF(prt_level>9)WRITE(lunout,*)                                 &
    97      &               pdf,  Qmix(ff), aire, ff
    98          ff=ff+df
    99          enddo
    100 c
    101 c         do ff=0.0+df,1.0 - 2.*df,df
    102           ff=df
    103           dowhile ( ff .le. 1.0 - 2.*df )
    104               pdf = (Qmix(ff+df)- Qmix(ff)) * (1.-ff) / df
    105               sigma = sigma+pdf*(ff - mu)*(ff - mu)*df
    106          ff=ff+df
    107          enddo
    108          sigma = sqrt(sigma)
    109 c
    110         if (abs(aire-1.0) .gt. 0.02) then
    111             write(lunout,*)'WARNING:: AREA OF MIXING PDF IS::', aire
    112             abort_message = ''
    113             CALL abort_gcm (modname,abort_message,1)
    114         else
    115             print *,'Area, mean & std deviation are ::', aire,mu,sigma
    116         endif
    117       endif     !  (iflag_mix .gt. 0)
    11819
    119       RETURN
    120       END
     20  ! --   Mixing probability distribution functions
     21
     22  REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f
     23
     24  qcoef1(f) = tanh(f/gammas)
     25  qcoef2(f) = (tanh(f/gammas)+gammas*log(cosh((1.-f)/gammas)/cosh(f/gammas)))
     26  qff(f) = max(min(f,1.), 0.)
     27  qfff(f) = min(qff(f), scut)
     28  qmix1(f) = (tanh((qff(f)-fmax)/gammas)+qcoef1max)/qcoef2max
     29  rmix1(f) = (gammas*log(cosh((qff(f)-fmax)/gammas))+qff(f)*qcoef1max)/ &
     30    qcoef2max
     31  qmix2(f) = -log(1.-qfff(f))/scut
     32  rmix2(f) = (qfff(f)+(1.-qff(f))*log(1.-qfff(f)))/scut
     33  qmix(f) = qqa1*qmix1(f) + qqa2*qmix2(f)
     34  rmix(f) = qqa1*rmix1(f) + qqa2*rmix2(f)
     35
     36  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     37
     38
     39  ! ===========================================================================
     40  ! READ IN PARAMETERS FOR THE MIXING DISTRIBUTION
     41  ! AND PASS THESE THROUGH A COMMON BLOCK TO SUBROUTINE CONVECT etc.
     42  ! (Written by V.T.J. Phillips, 20-30/Jan/99)
     43  ! ===========================================================================
     44
     45  ! line 1:  a flag (0 or 1) to decide whether P(F) = 1 or the general P(F)
     46  ! is to be
     47  ! used, followed by SCUT, which is the cut-off value of F in CONVECT
     48  ! line 2:  blank
     49  ! line 3:  the coefficients for the linear combination of P(F)s to
     50  ! make the general P(F)
     51  ! line 4:  blank
     52  ! line 5:  gammas, Fmax for the cosh^2 component of P(F)
     53  ! line 6:  blank
     54  ! line 7:  alphas for the 1st irrational P(F)
     55  ! line 8:  blank
     56  ! line 9:  betas  for the 2nd irrational P(F)
     57
     58
     59  ! c$$$        open(57,file='parameter_mix.data')
     60  ! c$$$
     61  ! c$$$        read(57,*) iflag_mix, scut
     62  ! c$$$        read(57,*)
     63  ! c$$$        if(iflag_mix .gt. 0) then
     64  ! c$$$              read(57,*) qqa1, qqa2
     65  ! c$$$              read(57,*)
     66  ! c$$$              read(57,*) gammas, Fmax
     67  ! c$$$              read(57,*)
     68  ! c$$$              read(57,*) alphas
     69  ! c$$$         endif
     70  ! c$$$         close(57)
     71
     72
     73  IF (iflag_mix>0) THEN
     74
     75    ! --      Normalize Pdf weights
     76
     77    sumcoef = qqa1 + qqa2
     78    qqa1 = qqa1/sumcoef
     79    qqa2 = qqa2/sumcoef
     80
     81    qcoef1max = qcoef1(fmax)
     82    qcoef2max = qcoef2(fmax)
     83
     84    sigma = 0.
     85    aire = 0.0
     86    pdf = 0.0
     87    mu = 0.0
     88    df = 0.0001
     89
     90    ! do ff = 0.0 + df, 1.0 - 2.*df, df
     91    ff = df
     92    DO WHILE (ff<=1.0-2.*df)
     93      pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
     94      aire = aire + (qmix(ff+df)-qmix(ff))*(1.-ff)
     95      mu = mu + pdf*ff*df
     96      IF (prt_level>9) WRITE (lunout, *) pdf, qmix(ff), aire, ff
     97      ff = ff + df
     98    END DO
     99
     100    ! do ff=0.0+df,1.0 - 2.*df,df
     101    ff = df
     102    DO WHILE (ff<=1.0-2.*df)
     103      pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
     104      sigma = sigma + pdf*(ff-mu)*(ff-mu)*df
     105      ff = ff + df
     106    END DO
     107    sigma = sqrt(sigma)
     108
     109    IF (abs(aire-1.0)>0.02) THEN
     110      WRITE (lunout, *) 'WARNING:: AREA OF MIXING PDF IS::', aire
     111      abort_message = ''
     112      CALL abort_gcm(modname, abort_message, 1)
     113    ELSE
     114      PRINT *, 'Area, mean & std deviation are ::', aire, mu, sigma
     115    END IF
     116  END IF !  (iflag_mix .gt. 0)
     117
     118  RETURN
     119END SUBROUTINE cv3_inip
Note: See TracChangeset for help on using the changeset viewer.