Changeset 2197 for LMDZ5/trunk


Ignore:
Timestamp:
Feb 9, 2015, 8:13:05 AM (10 years ago)
Author:
Ehouarn Millour
Message:

Added 'implicit none' statements and proper variable definitions where they were missing.
EM

Location:
LMDZ5/trunk/libf
Files:
24 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/bibio/i1mach.F

    r1907 r2197  
    11*DECK I1MACH
    22      INTEGER FUNCTION I1MACH (I)
     3      IMPLICIT NONE
    34C***BEGIN PROLOGUE  I1MACH
    45C***PURPOSE  Return integer machine dependent constants.
    … …  
    9596      SAVE IMACH
    9697      EQUIVALENCE (IMACH(4),OUTPUT)
     98      INTEGER I
    9799C***FIRST EXECUTABLE STATEMENT  I1MACH
    98100      IMACH( 1) =         5

  • LMDZ5/trunk/libf/bibio/j4save.F

    r1907 r2197  
    11*DECK J4SAVE
    22      FUNCTION J4SAVE (IWHICH, IVALUE, ISET)
     3      IMPLICIT NONE
    34C***BEGIN PROLOGUE  J4SAVE
    45C***SUBSIDIARY
    … …  
    5960      DATA IPARAM(5)/1/
    6061      DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/
     62      INTEGER J4SAVE,IWHICH,IVALUE
    6163C***FIRST EXECUTABLE STATEMENT  J4SAVE
    6264      J4SAVE = IPARAM(IWHICH)

  • LMDZ5/trunk/libf/bibio/xercnt.F

    r1907 r2197  
    11*DECK XERCNT
    22      SUBROUTINE XERCNT (LIBRAR, SUBROU, MESSG, NERR, LEVEL, KONTRL)
     3      IMPLICIT NONE
    34C***BEGIN PROLOGUE  XERCNT
    45C***SUBSIDIARY
    … …  
    5657C***END PROLOGUE  XERCNT
    5758      CHARACTER*(*) LIBRAR, SUBROU, MESSG
     59      INTEGER NERR, LEVEL, KONTRL
    5860C***FIRST EXECUTABLE STATEMENT  XERCNT
    5961      RETURN

  • LMDZ5/trunk/libf/bibio/xermsg.F

    r1907 r2197  
    11*DECK XERMSG
    22      SUBROUTINE XERMSG (LIBRAR, SUBROU, MESSG, NERR, LEVEL)
     3      IMPLICIT NONE
    34C***BEGIN PROLOGUE  XERMSG
    45C***PURPOSE  Process error messages for SLATEC and other libraries.
    … …  
    189190      CHARACTER*72  TEMP
    190191      CHARACTER*20  LFIRST
     192      INTEGER NERR, LEVEL, LKNTRL
     193      INTEGER J4SAVE, MAXMES, KDUMMY, I, KOUNT, LERR, LLEVEL
     194      INTEGER MKNTRL, LTEMP
    191195C***FIRST EXECUTABLE STATEMENT  XERMSG
    192196      LKNTRL = J4SAVE (2, 0, .FALSE.)

  • LMDZ5/trunk/libf/bibio/xerprn.F

    r1907 r2197  
    11*DECK XERPRN
    22      SUBROUTINE XERPRN (PREFIX, NPREF, MESSG, NWRAP)
     3      IMPLICIT NONE
    34C***BEGIN PROLOGUE  XERPRN
    45C***SUBSIDIARY
    … …  
    8182      CHARACTER*2 NEWLIN
    8283      PARAMETER (NEWLIN = '$$')
     84      INTEGER N, I1MACH, I, LPREF, LWRAP, LENMSG, NEXTC
     85      INTEGER LPIECE, IDELTA
    8386C***FIRST EXECUTABLE STATEMENT  XERPRN
    8487      CALL XGETUA(IU,NUNIT)

  • LMDZ5/trunk/libf/bibio/xersve.F

    r1907 r2197  
    22      SUBROUTINE XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL,
    33     +   ICOUNT)
     4      IMPLICIT NONE
    45C***BEGIN PROLOGUE  XERSVE
    56C***SUBSIDIARY
    … …  
    6667      SAVE LIBTAB, SUBTAB, MESTAB, NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG
    6768      DATA KOUNTX/0/, NMSG/0/
     69      INTEGER NERR,LEVEL,KONTRL
     70      INTEGER LENTAB, NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG
     71      INTEGER KFLAG, ICOUNT, NUNIT, KUNIT, IUNIT, I1MACH, I
    6872C***FIRST EXECUTABLE STATEMENT  XERSVE
    6973C

  • LMDZ5/trunk/libf/bibio/xgetua.F

    r1907 r2197  
    11*DECK XGETUA
    22      SUBROUTINE XGETUA (IUNITA, N)
     3      IMPLICIT NONE
    34C***BEGIN PROLOGUE  XGETUA
    45C***PURPOSE  Return unit number(s) to which error messages are being
    … …  
    4142C***END PROLOGUE  XGETUA
    4243      DIMENSION IUNITA(5)
     44      INTEGER IUNITA, N, J4SAVE, INDEX, I
    4345C***FIRST EXECUTABLE STATEMENT  XGETUA
    4446      N = J4SAVE(5,0,.FALSE.)

  • LMDZ5/trunk/libf/dyn3d_common/grid_atob.F

    r2088 r2197  
    936936c
    937937      SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,im,jm,distance)
     938      IMPLICIT NONE
    938939c
    939940c Auteur: Laurent Li (le 30 decembre 1996)
    … …  
    958959      REAL radius
    959960      PARAMETER (radius=6371229.)
     961      INTEGER i,j
    960962c
    961963      pi = 4.0 * ATAN(1.0)

  • LMDZ5/trunk/libf/dyn3d_common/grid_noro.F

    r1944 r2197  
    5454C=======================================================================
    5555
    56       IMPLICIT INTEGER (I,J)
    57       IMPLICIT REAL(X,Z)
     56      IMPLICIT NONE
    5857     
    5958          parameter(iusn=2160,jusn=1080,iext=216, epsfra = 1.e-5)
    … …  
    8988      REAL a(2200),b(2200),c(1100),d(1100)
    9089      logical masque_lu
     90      INTEGER iusn, jusn, iext
     91      INTEGER i,j,ii,jj
     92      REAL epsfra, xpi, rad, zdeltay, masque
     93      REAL zdeltax, zlenx, zleny, xincr
     94      REAL zbordnor, zbordsud, weighy, zbordest, zbordoue, weighx
     95      REAL zllmmea, zllmstd, zllmsig, zllmgam, zllmpic, zllmval
     96      REAL zllmthe, zminthe
     97      REAL xk, xl, xm, xp, xq, xw
     98      REAL zmeanor, zmeasud, zstdnor, zstdsud, zsignor, zsigsud
     99      REAL zweinor, zweisud, zpicnor, zpicsud, zvalnor, zvalsud
    91100c
    92101      print *,' parametres de l orographie a l echelle sous maille'
    … …  
    455464
    456465      SUBROUTINE MVA9(X,IMAR,JMAR)
    457 
     466      IMPLICIT NONE
    458467C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
    459 
     468      INTEGER IMAR,JMAR
    460469      REAL X(IMAR,JMAR),XF(IMAR,JMAR)
    461470      real WEIGHTpb(-1:1,-1:1)
     471      INTEGER I,J,IS,JS
     472      REAL SUM
    462473
    463474

  • LMDZ5/trunk/libf/dyn3d_common/juldate.F

    r1944 r2197  
    77c       En entree:an,mois,jour,heure,min.,sec.
    88c       En sortie:tjd
    9         implicit real (a-h,o-z)
     9        IMPLICIT NONE
     10        INTEGER,INTENT(IN) :: ian,imoi,ijou,oh,om,os
     11        REAL,INTENT(OUT) :: tjd,tjdsec
     12       
     13        REAL frac,year,rmon,cf,a,b
     14        INTEGER ojou
     15       
    1016        frac=((os/60.+om)/60.+oh)/24.
    1117        ojou=dble(ijou)+frac

  • LMDZ5/trunk/libf/dyn3d_common/massbar.F

    r1945 r2197  
    33!
    44      SUBROUTINE massbar(  masse, massebx, masseby )
     5      IMPLICIT NONE
    56c
    67c **********************************************************************
    … …  
    2425      REAL    masse( ip1jmp1,llm ), massebx( ip1jmp1,llm )  ,
    2526     *      masseby(   ip1jm,llm )
     27      INTEGER ij,l
    2628c
    2729c

  • LMDZ5/trunk/libf/dyn3d_common/massbarxy.F

    r1945 r2197  
    33!
    44      SUBROUTINE massbarxy(  masse, massebxy )
     5      IMPLICIT NONE
    56c
    67c **********************************************************************
    … …  
    2324c
    2425       REAL  masse( ip1jmp1,llm ), massebxy( ip1jm,llm )
     26       INTEGER ij,l
    2527c
    2628

  • LMDZ5/trunk/libf/dyn3d_common/ppm3d.F

    r1952 r2197  
    6666     &                  JNP,j1,NLAY,AP,BP,PT,AE,fill,dum,Umax)
    6767
    68 c      implicit none
     68      implicit none
    6969
    7070c     rajout de déclarations
    … …  
    270270C     User modifiable parameters
    271271C
    272       parameter (Jmax = 361, kmax = 150)
     272      integer,parameter :: Jmax = 361, kmax = 150
    273273C
    274274C ****6***0*********0*********0*********0*********0*********0**********72
    … …  
    299299      data NDT0, NSTEP /0, 0/
    300300      data cross /.true./
     301      REAL DTDY, DTDY5, RCAP
     302      INTEGER JS0, JN0, IML, JMR, IMJM
    301303      SAVE DTDY, DTDY5, RCAP, JS0, JN0, IML,
    302304     &     DTDX, DTDX5, ACOSP, COSP, COSE, DAP,DBK
    303305C
     306      INTEGER NDT0, NSTEP, j2, k,j,i,ic,l,JS,JN,IMH
     307      INTEGER IU,IIU,JT,iad,jad,krd
     308      REAL r23,r3,PI,DL,DP,DT,CR1,MAXDT,ZTC,D5
     309      REAL sum1,sum2,ru
    304310           
    305311      JMR = JNP -1
    … …  
    756762      subroutine FZPPM(IMR,JNP,NLAY,j1,DQ,WZ,P,DC,DQDT,AR,AL,A6,
    757763     &                 flux,wk1,wk2,wz2,delp,KORD)
    758       parameter ( kmax = 150 )
    759       parameter ( R23 = 2./3., R3 = 1./3.)
     764      implicit none
     765      integer,parameter :: kmax = 150
     766      real,parameter :: R23 = 2./3., R3 = 1./3.
     767      integer IMR,JNP,NLAY,J1,KORD
    760768      real WZ(IMR,JNP,NLAY),P(IMR,JNP,NLAY),DC(IMR,JNP,NLAY),
    761769     &     wk1(IMR,*),delp(IMR,JNP,NLAY),DQ(IMR,JNP,NLAY),
    … …  
    764772      real AR(IMR,*),AL(IMR,*),A6(IMR,*),flux(IMR,*),wk2(IMR,*),
    765773     &     wz2(IMR,*)
     774      integer JMR,IMJM,NLAYM1,LMT,K,I,J
     775      real c0,c1,c2,tmp,qmax,qmin,a,b,fct,a1,a2,cm,cp
    766776C
    767777      JMR = JNP - 1
    … …  
    922932      subroutine xtp(IMR,JNP,IML,j1,j2,JN,JS,PU,DQ,Q,UC,
    923933     &               fx1,xmass,IORD)
     934      implicit none
     935      integer IMR,JNP,IML,j1,j2,JN,JS,IORD
     936      real PU,DQ,Q,UC,fx1,xmass
     937      real dc,qtmp
     938      integer ISAVE(IMR)
    924939      dimension UC(IMR,*),DC(-IML:IMR+IML+1),xmass(IMR,JNP)
    925940     &    ,fx1(IMR+1),DQ(IMR,JNP),qtmp(-IML:IMR+1+IML)
    926       dimension PU(IMR,JNP),Q(IMR,JNP),ISAVE(IMR)
     941      dimension PU(IMR,JNP),Q(IMR,JNP)
     942      integer jvan,j1vl,j2vl,j,i,iu,itmp,ist,imp
     943      real rut
    927944C
    928945      IMP = IMR + 1
    … …  
    10311048C
    10321049      subroutine fxppm(IMR,IML,UT,P,DC,flux,IORD)
    1033       parameter ( R3 = 1./3., R23 = 2./3. )
     1050      implicit none
     1051      integer IMR,IML,IORD
     1052      real UT,P,DC,flux
     1053      real,parameter ::  R3 = 1./3., R23 = 2./3.
    10341054      DIMENSION UT(*),flux(*),P(-IML:IMR+IML+1),DC(-IML:IMR+IML+1)
    1035       DIMENSION AR(0:IMR),AL(0:IMR),A6(0:IMR)
    1036       integer LMT 
     1055      REAL :: AR(0:IMR),AL(0:IMR),A6(0:IMR)
     1056      integer LMT,IMP,JLVL,i
    10371057c      logical first
    10381058c      data first /.true./
    … …  
    10881108C
    10891109      subroutine xmist(IMR,IML,P,DC)
    1090       parameter( R24 = 1./24.)
    1091       dimension P(-IML:IMR+1+IML),DC(-IML:IMR+1+IML)
     1110      implicit none
     1111      integer IMR,IML
     1112      real,parameter :: R24 = 1./24.
     1113      real :: P(-IML:IMR+1+IML),DC(-IML:IMR+1+IML)
     1114      integer :: i
     1115      real :: tmp,pmax,pmin
    10921116C
    10931117      do 10  i=1,IMR
    … …  
    11011125      subroutine ytp(IMR,JNP,j1,j2,acosp,RCAP,DQ,P,VC,DC2
    11021126     &              ,ymass,fx,A6,AR,AL,JORD)
     1127      implicit none
     1128      integer :: IMR,JNP,j1,j2,JORD
     1129      real :: acosp,RCAP,DQ,P,VC,DC2,ymass,fx,A6,AR,AL
    11031130      dimension P(IMR,JNP),VC(IMR,JNP),ymass(IMR,JNP)
    11041131     &       ,DC2(IMR,JNP),DQ(IMR,JNP),acosp(JNP)
    11051132C Work array
    11061133      DIMENSION fx(IMR,JNP),AR(IMR,JNP),AL(IMR,JNP),A6(IMR,JNP)
     1134      integer :: JMR,len,i,jt,j
     1135      real :: sum1,sum2
    11071136C
    11081137      JMR = JNP - 1
    … …  
    11611190C
    11621191      subroutine  ymist(IMR,JNP,j1,P,DC,ID)
    1163       parameter ( R24 = 1./24. )
    1164       dimension P(IMR,JNP),DC(IMR,JNP)
     1192      implicit none
     1193      integer :: IMR,JNP,j1,ID
     1194      real,parameter :: R24 = 1./24.
     1195      real :: P(IMR,JNP),DC(IMR,JNP)
     1196      integer :: iimh,jmr,ijm3,imh,i
     1197      real :: pmax,pmin,tmp
    11651198C
    11661199      IMH = IMR / 2
    … …  
    12391272C
    12401273      subroutine fyppm(VC,P,DC,flux,IMR,JNP,j1,j2,A6,AR,AL,JORD)
    1241       parameter ( R3 = 1./3., R23 = 2./3. )
     1274      implicit none
     1275      integer IMR,JNP,j1,j2,JORD
     1276      real,parameter :: R3 = 1./3., R23 = 2./3.
    12421277      real VC(IMR,*),flux(IMR,*),P(IMR,*),DC(IMR,*)
    12431278C Local work arrays.
    12441279      real AR(IMR,JNP),AL(IMR,JNP),A6(IMR,JNP)
    1245       integer LMT
     1280      integer LMT,i
     1281      integer IMH,JMR,j11,IMJM1,len
    12461282c      logical first
    12471283C      data first /.true./
    … …  
    13151351C
    13161352        subroutine yadv(IMR,JNP,j1,j2,p,VA,ady,wk,IAD)
     1353        implicit none
     1354        integer IMR,JNP,j1,j2,IAD
    13171355        REAL p(IMR,JNP),ady(IMR,JNP),VA(IMR,JNP)
    13181356        REAL WK(IMR,-1:JNP+2)
     1357        INTEGER JMR,IMH,i,j,jp
     1358        REAL rv,a1,b1,sum1,sum2
    13191359C
    13201360        JMR = JNP-1
    … …  
    14011441C
    14021442        subroutine xadv(IMR,JNP,j1,j2,p,UA,JS,JN,IML,adx,IAD)
     1443        implicit none
     1444        INTEGER IMR,JNP,j1,j2,JS,JN,IML,IAD
    14031445        REAL p(IMR,JNP),adx(IMR,JNP),qtmp(-IMR:IMR+IMR),UA(IMR,JNP)
     1446        INTEGER JMR,j,i,ip,iu,iiu
     1447        REAL ru,a1,b1
    14041448C
    14051449        JMR = JNP-1
    … …  
    14891533C
    14901534      subroutine lmtppm(DC,A6,AR,AL,P,IM,LMT)
     1535      implicit none
    14911536C
    14921537C A6 =  CURVATURE OF THE TEST PARABOLA
    … …  
    15031548C LMT = 2: POSITIVE-DEFINITE CONSTRAINT
    15041549C
    1505       parameter ( R12 = 1./12. )
    1506       dimension A6(IM),AR(IM),AL(IM),P(IM),DC(IM)
     1550      real,parameter :: R12 = 1./12.
     1551      real :: A6(IM),AR(IM),AL(IM),P(IM),DC(IM)
     1552      integer :: IM,LMT
     1553      INTEGER i
     1554      REAL da1,da2,a6da,fmin
    15071555C
    15081556      if(LMT.eq.0) then
    … …  
    15641612C
    15651613      subroutine A2C(U,V,IMR,JMR,j1,j2,CRX,CRY,dtdx5,DTDY5)
    1566       dimension U(IMR,*),V(IMR,*),CRX(IMR,*),CRY(IMR,*),DTDX5(*)
     1614      implicit none
     1615      integer IMR,JMR,j1,j2
     1616      real :: U(IMR,*),V(IMR,*),CRX(IMR,*),CRY(IMR,*),DTDX5(*),DTDY5
     1617      integer i,j
    15671618C
    15681619      do 35 j=j1,j2
    … …  
    15791630C
    15801631      subroutine cosa(cosp,cose,JNP,PI,DP)
    1581       dimension cosp(*),cose(*)
     1632      implicit none
     1633      integer JNP
     1634      real :: cosp(*),cose(*),PI,DP
     1635      integer JMR,j,jeq
     1636      real ph5
    15821637      JMR = JNP-1
    15831638      do 55 j=2,JNP
    … …  
    16061661C
    16071662      subroutine cosc(cosp,cose,JNP,PI,DP)
    1608       dimension cosp(*),cose(*)
     1663      implicit none
     1664      integer JNP
     1665      real :: cosp(*),cose(*),PI,DP
     1666      real phi
     1667      integer j
    16091668C
    16101669      phi = -0.5*PI
    … …  
    16281687     &                   cross,IC,NSTEP)
    16291688C
    1630       parameter( tiny = 1.E-60 )
    1631       DIMENSION Q(IMR,JNP,NLAY),qtmp(IMR,JNP),cosp(*),acosp(*)
     1689      real,parameter :: tiny = 1.E-60
     1690      INTEGER :: IMR,JNP,NLAY,j1,j2,IC,NSTEP
     1691      REAL :: Q(IMR,JNP,NLAY),qtmp(IMR,JNP),cosp(*),acosp(*)
    16321692      logical cross
     1693      INTEGER :: NLAYM1,len,ip,L,icr,ipy,ipx,i
     1694      real :: qup,qly,dup,sum
    16331695C
    16341696      NLAYM1 = NLAY-1
    … …  
    17301792C
    17311793      subroutine filcr(q,IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
    1732       dimension q(IMR,*),cosp(*),acosp(*)
     1794      implicit none
     1795      integer :: IMR,JNP,j1,j2,icr
     1796      real :: q(IMR,*),cosp(*),acosp(*),tiny
     1797      integer :: i,j
     1798      real :: dq,dn,d0,d1,ds,d2
    17331799      icr = 0
    17341800      do 65 j=j1+1,j2-1
    … …  
    18281894C
    18291895      subroutine filns(q,IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
    1830       dimension q(IMR,*),cosp(*),acosp(*)
     1896      implicit none
     1897      integer :: IMR,JNP,j1,j2,ipy
     1898      real :: q(IMR,*),cosp(*),acosp(*),tiny
     1899      real :: DP,CAP1,dq,dn,d0,d1,ds,d2
     1900      INTEGER :: i,j
    18311901c      logical first
    18321902c      data first /.true./
    … …  
    19101980C
    19111981      subroutine filew(q,qtmp,IMR,JNP,j1,j2,ipx,tiny)
    1912       dimension q(IMR,*),qtmp(JNP,IMR)
     1982      implicit none
     1983      integer :: IMR,JNP,j1,j2,ipx
     1984      real :: q(IMR,*),qtmp(JNP,IMR),tiny
     1985      integer :: i,j
     1986      real :: d0,d1,d2
    19131987C
    19141988      ipx = 0
    … …  
    19832057C
    19842058      subroutine zflip(q,im,km,nc)
     2059      implicit none
    19852060C This routine flip the array q (in the vertical).
     2061      integer :: im,km,nc
    19862062      real q(im,km,nc)
    19872063C local dynamic array
    19882064      real qtmp(im,km)
     2065      integer IC,k,i
    19892066C
    19902067      do 4000 IC = 1, nc

  • LMDZ5/trunk/libf/dyn3d_common/ran1.F

    r1944 r2197  
    33!
    44      FUNCTION RAN1(IDUM)
    5       DIMENSION R(97)
    6       save r
    7       save iff,ix1,ix2,ix3
    8       PARAMETER (M1=259200,IA1=7141,IC1=54773,RM1=3.8580247E-6)
    9       PARAMETER (M2=134456,IA2=8121,IC2=28411,RM2=7.4373773E-6)
    10       PARAMETER (M3=243000,IA3=4561,IC3=51349)
    11       DATA IFF /0/
     5      IMPLICIT NONE
     6      REAL RAN1
     7      REAL,SAVE :: R(97)
     8      REAL,PARAMETER :: RM1=3.8580247E-6,RM2=7.4373773E-6
     9      INTEGER,SAVE :: IFF=0
     10      integer,save :: ix1,ix2,ix3
     11      INTEGER,PARAMETER :: M1=259200,IA1=7141,IC1=54773
     12      INTEGER,PARAMETER :: M2=134456,IA2=8121,IC2=28411
     13      INTEGER,PARAMETER :: M3=243000,IA3=4561,IC3=51349
     14      INTEGER :: IDUM,J
     15
    1216      IF (IDUM.LT.0.OR.IFF.EQ.0) THEN
    1317        IFF=1

  • LMDZ5/trunk/libf/filtrez/acc.F

    r1907 r2197  
    33!
    44        subroutine acc(vec,d,im)
    5         dimension vec(im,im),d(im)
     5        implicit none
     6        integer :: im
     7        real :: vec(im,im),d(im)
     8        integer :: i,j
     9        real ::sum
     10        real,external :: ssum
    611        do j=1,im
    712          do i=1,im

  • LMDZ5/trunk/libf/filtrez/eigen.F

    r1907 r2197  
    33!
    44      SUBROUTINE eigen( e,d)
     5      IMPLICIT NONE
    56#include "dimensions.h"
    6       dimension e( iim,iim ), d( iim )
    7       dimension asm( iim )
     7      real :: e( iim,iim ), d( iim )
     8      real :: asm( iim )
     9      integer :: im,i,j
    810      im=iim
    911c

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

    r1992 r2197  
    33
    44SUBROUTINE clift(p, t, rr, rs, plcl, dplcldt, dplcldq)
     5IMPLICIT NONE
    56  ! ***************************************************************
    67  ! *                                                             *
    … …  
    4142
    4243  include "YOMCST.h"
     44  real :: p,t,rr,rs,plcl,dplcldt,dplcldq,cpd,cpv,cl,cpvmcl,eps,alv0,a,b
     45  real :: rh,chi,alv
    4346
    4447  cpd = rcpd

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

    r1992 r2197  
    1717  USE dimphy
    1818  USE infotrac, ONLY: nbtr
    19 
     19  IMPLICIT NONE
    2020  include "dimensions.h"
    2121  INTEGER na
    … …  
    7373
    7474
    75 
     75  REAL :: cpv,cl,cpvmcl,eps,alv0,rdcp,pbcrit,ptcrit,sigd,spfac
     76  REAL :: tau,beta,alpha,dtcrit,dtovsh,ahm,rm,um,vm,dphinv
     77  REAL :: a2,x,tvx,tvy,plcl,pden,dpbase,tvpbase,tvbase,tdif
     78  REAL :: ath1,ath,delti,deltap,dcape,dlnp,sigold,dtmin,fac,w
     79  REAL :: amu,rti,cpd,bf2,anum,denom,dei,altem,cwat,stemp,qp
     80  REAL :: scrit,alt,smax,asij,wgh,sjmax,sjmin,smid,delp,delm
     81  REAL :: asum,bsum,csum,wflux,tinv,wdtrain,awat,afac,afac1,afac2
     82  REAL :: bfac,pr1,pr2,sigt,b6,c6,revap,tevap,delth,amfac,amp2
     83  REAL :: xf,tf,af,bf,fac2,ur,sru,d,ampmax,dpinv,am,amde,cpinv
     84  REAL :: amp1,ad,rat,ax,bx,cx,dx,ex,dsum
     85  INTEGER :: nk,i,j,nopt,jn,k,im,jm,n
    7686
    7787  REAL dnwd0(nd) !  precipitation driven unsaturated downdraft flux

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

    r1992 r2197  
    99  ! modified by :                                               *
    1010  ! **************************************************************
    11 
     11  IMPLICIT NONE
    1212  include "YOMCST2.h"
    1313
    … …  
    1919
    2020  REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f
     21  REAL :: sumcoef,sigma,aire,pdf,mu,df,ff
    2122
    2223  qcoef1(f) = tanh(f/gammas)

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

    r1992 r2197  
    625625    mmin_alpha, kstar, slope, f1, f2, f3, naz, levbot, levtop, il1, il2, &
    626626    nlons, nlevs, nazmth, sigsqmcw, sigmatm, lorms, sigalpmc, f2mod)
    627 
    628627  ! Smooth cutoff wavenumbers and total rms velocity in the vertical
    629628  ! direction NSMAX times, using FLUX_U as temporary work array.
    … …  
    715714    i_alpha, mmin_alpha, kstar, slope, f1, f2, f3, naz, levbot, levtop, il1, &
    716715    il2, nlons, nlevs, nazmth, sigsqmcw, sigmatm, lorms, sigalpmc, f2mod)
    717 
     716  IMPLICIT NONE
    718717  ! This routine calculates the cutoff vertical wavenumber and velocity
    719718  ! variances on a longitude by altitude grid for the Hines' Doppler
    … …  
    766765
    767766  INTEGER naz, levbot, levtop, il1, il2, nlons, nlevs, nazmth
    768   REAL slope, kstar(nlons), f1, f2, f3
     767  REAL slope, kstar(nlons), f1, f2, f3, f2mfac
    769768  REAL m_alpha(nlons, nlevs, nazmth)
    770769  REAL sigma_alpha(nlons, nlevs, nazmth)
    … …  
    938937SUBROUTINE hines_wind(v_alpha, vel_u, vel_v, naz, il1, il2, lev1, lev2, &
    939938    nlons, nlevs, nazmth)
    940 
     939    IMPLICIT NONE
    941940  ! This routine calculates the azimuthal horizontal background wind
    942941  ! components
    … …  
    10341033    m_alpha, ak_alpha, k_alpha, slope, naz, il1, il2, lev1, lev2, nlons, &
    10351034    nlevs, nazmth, lorms)
    1036 
     1035    IMPLICIT NONE
    10371036  ! Calculate zonal and meridional components of the vertical flux
    10381037  ! of horizontal momentum and corresponding wave drag (force per unit mass)
    … …  
    10891088  ! Internal variables.
    10901089
    1091   INTEGER i, l, lev1p, lev2m
     1090  INTEGER i, l, lev1p, lev2m, lev2p
    10921091  REAL cos45, prod2, prod4, prod6, prod8, dendz, dendz2
    10931092  DATA cos45/0.7071068/
    … …  
    12341233    bvfreq, density, densb, sigma_t, visc_mol, kstar, slope, f2, f3, f5, f6, &
    12351234    naz, il1, il2, lev1, lev2, nlons, nlevs, nazmth)
    1236 
     1235  IMPLICIT NONE
    12371236  ! This routine calculates the gravity wave induced heating and
    12381237  ! diffusion coefficient on a longitude by altitude grid for
    … …  
    13551354SUBROUTINE hines_sigma(sigma_t, sigma_alpha, sigsqh_alpha, naz, lev, il1, &
    13561355    il2, nlons, nlevs, nazmth)
    1357 
     1356  IMPLICIT NONE
    13581357  ! This routine calculates the total rms and azimuthal rms horizontal
    13591358  ! velocities at a given level on a longitude by altitude grid for
    … …  
    14501449SUBROUTINE hines_intgrl(i_alpha, v_alpha, m_alpha, bvfb, slope, naz, lev, &
    14511450    il1, il2, nlons, nlevs, nazmth, lorms)
    1452 
     1451  IMPLICIT NONE
    14531452  ! This routine calculates the vertical wavenumber integral
    14541453  ! for a single vertical level at each azimuth on a longitude grid
    … …  
    16431642    alt_cutoff, smco, nsmax, iheatcal, k_alpha, ierror, nmessg, nlons, &
    16441643    nazmth, coslat)
    1645 
     1644  IMPLICIT NONE
    16461645  ! This routine specifies various parameters needed for the
    16471646  ! the Hines' Doppler spread gravity wave drag parameterization scheme.
    … …  
    17721771    sigma_alpha, v_alpha, m_alpha, iu_print, iv_print, nmessg, ilprt1, &
    17731772    ilprt2, levprt1, levprt2, naz, nlons, nlevs, nazmth)
    1774 
     1773  IMPLICIT NONE
    17751774  ! Print out altitude profiles of various quantities from
    17761775  ! Hines' Doppler spread gravity wave drag parameterization scheme.
    … …  
    18641863SUBROUTINE hines_exp(data, data_zmax, alt, alt_exp, iorder, il1, il2, lev1, &
    18651864    lev2, nlons, nlevs)
    1866 
     1865  IMPLICIT NONE
    18671866  ! This routine exponentially damps a longitude by altitude array
    18681867  ! of data above a specified altitude.
    … …  
    19411940SUBROUTINE vert_smooth(data, work, coeff, nsmooth, il1, il2, lev1, lev2, &
    19421941    nlons, nlevs)
    1943 
     1942  IMPLICIT NONE
    19441943  ! Smooth a longitude by altitude array in the vertical over a
    19451944  ! specified number of levels using a three point smoother.

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

    r1992 r2197  
    44SUBROUTINE ini_wake(wape, fip, it_wape_prescr, wape_prescr, fip_prescr, &
    55    alp_bl_prescr, ale_bl_prescr)
     6  IMPLICIT NONE
    67  ! **************************************************************
    78  ! *
    … …  
    3940  include 'iniprint.h'
    4041  ! declarations
     42  REAL wape, fip, wape_prescr, fip_prescr
     43  INTEGER it_wape_prescr
    4144  REAL ale_bl_prescr
    4245  REAL alp_bl_prescr
    4346  REAL it
     47  REAL w,f,alebl,alpbl
    4448
    4549  ! FH A mettre si besoin dans physiq.def

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

    r1992 r2197  
    33
    44SUBROUTINE tlift43(p, t, q, qs, gz, icb, nk, tvp, tpk, clw, nd, nl, kk)
     5  IMPLICIT NONE
    56  REAL gz(nd), tpk(nd), clw(nd), p(nd)
    67  REAL t(nd), q(nd), qs(nd), tvp(nd), lv0
    7 
     8  INTEGER icb, nk, nd, nl, kk
     9  REAL cpd, cpv,  cl, g, rowl, gravity, cpvmcl, eps, epsi
     10  REAL ah0, cpp, cpinv, tg, qg, alv, s, ahg, tc, denom, es
     11  INTEGER i, nst, nsb, j
    812  ! ***   ASSIGN VALUES OF THERMODYNAMIC CONSTANTS     ***
    913

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

    r1992 r2197  
    44SUBROUTINE tlift(p, t, rr, rs, gz, plcl, icb, nk, tvp, tpk, clw, nd, nl, &
    55    dtvpdt1, dtvpdq1)
    6 
     6  IMPLICIT NONE
    77  ! Argument NK ajoute (jyg) = Niveau de depart de la
    88  ! convection
    9 
    10   PARAMETER (na=60)
    11   REAL gz(nd), tpk(nd), clw(nd)
     9  INTEGER icb, nk, nd, nl
     10  INTEGER,PARAMETER :: na=60
     11  REAL gz(nd), tpk(nd), clw(nd), plcl
    1212  REAL t(nd), rr(nd), rs(nd), tvp(nd), p(nd)
    1313  REAL dtvpdt1(nd), dtvpdq1(nd) ! Derivatives of parcel virtual
    … …  
    1717  REAL dtpdt1(na), dtpdq1(na) ! Derivatives of parcel temperature
    1818  ! wrt T1 and Q1
    19 
     19  REAL gravity, cpd, cpv, cl, ci, cpvmcl, clmci, eps, alv0, alf0
     20  REAL cpp, cpinv, ah0, alf, tg, s, ahg, tc, denom, alv, es, esi
     21  REAL qsat_new, snew
     22  INTEGER icbl, i, imin, j, icb1
    2023
    2124  LOGICAL ice_conv

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

    r2155 r2197  
    17561756  ! a une humidite positive dans la zone (x) et dans la zone (w).
    17571757  ! ------------------------------------------------------
    1758 
     1758  IMPLICIT NONE
    17591759
    17601760  ! Input
    … …  
    17721772  REAL epsilon
    17731773  ! DATA epsilon/1.e-15/
     1774  INTEGER i,k
    17741775
    17751776  DO k = 1, nl
Note: See TracChangeset for help on using the changeset viewer.