Ignore:
Timestamp:
Mar 6, 2015, 3:12:12 PM (10 years ago)
Author:
emillour
Message:

Common dynamical core:
Updates in the dynamics to keeup up with updates in LMDZ5
(up to LMDZ5 trunk rev 2200):

  • compilation:
  • create_make_gcm : added processing of .f & .f90 files (not just .F and .F90)
  • makelmdz: add "mix" option for -io (ouptut with both IOIPSL and XIOS)
  • makelmdz_fcm: add "mix" option for -io
  • filtrez:
  • acc.F and eigen.F : add "implicit none" and variable declarations
  • bibio:
  • handle_err_m.F90: replace "stop" with call to abort_gcm()
  • i1mach.F, j4save.F: add "implicit none" and variable declarations
  • xercnt.F, xermsg.F, xerprn.F, xersve.F, xgetua.F: add "implicit none" and variable declarations
  • dyn3d_common:
  • disvert.F90 : added comments on meaning of "pa" variable
  • grid_atob.F : better control on level of default ouputs
  • infotrac.F90: update Earth-specific stuff (nqo water tracers)
  • interpre.F: correction on the size of input array w
  • juldate.F, massbar.F, ppm3d.F, ran1.F: add "implicit none" and variable declarations
  • sortvarc.F: code cleanup
  • iniacademic.F90: cleanup and extra sanity check.
  • dyn3d:
  • abort_gcm.F: additions for XIOS
  • conf_gcm.F90: transformed to free form from conf_gcm.F
  • gcm.F: added test to check that iphysiq is a multiple of iperiod
  • getparam.F90, guidz_mod.F: update from LMDZ5
  • integrd.F: replace stop with call_abort()
  • dyn3dpar:
  • abort_gcm.F: minor cleanup
  • gcm.F: added test to check that iphysiq is a multiple of iperiod
  • getparam.F90, guide_p_mod.F90: update from LMDZ5
  • integrd_p.F: abort with call_abort when there is negative surface pressure
  • leapfrog_p.F: add INCA specific stuff to keep up with current LMDZ5
  • conf_gcm.F90: transformed to free form from conf_gcm.F

EM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.COMMON/libf/dyn3d_common/ppm3d.F

    r1300 r1391  
    11!
    2 ! $Id: ppm3d.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: ppm3d.F 2197 2015-02-09 07:13:05Z emillour $
    33!
    44
    … …  
    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
Note: See TracChangeset for help on using the changeset viewer.