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

Location:
trunk/LMDZ.COMMON/libf/dyn3d_common
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.COMMON/libf/dyn3d_common/disvert.F90

    r1302 r1391  
    2727!-------------------------------------------------------------------------------
    2828! Read    in "comvert.h":
    29 ! pa                         !--- PURE PRESSURE COORDINATE FOR P<pa (in Pascals)
     29
     30! pa !--- vertical coordinate is close to a PRESSURE COORDINATE FOR P
     31! < 0.3 * pa (relative variation of p on a model level is < 0.1 %)
     32
    3033! preff                      !--- REFERENCE PRESSURE                 (101325 Pa)
    3134! Written in "comvert.h":

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

    r1300 r1391  
    11!
    2 ! $Id: grid_atob.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: grid_atob.F 2197 2015-02-09 07:13:05Z emillour $
    33!
    44      SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
    … …  
    5252      REAL zzmin
    5353#endif
     54      include "iniprint.h"
    5455c
    5556      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
    … …  
    118119         sortie(i,j) = sortie(i,j) / number(i,j)
    119120         ELSE
    120          PRINT*, 'probleme,i,j=', i,j
     121         if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j
    121122ccc         CALL ABORT_GCM("", "", 1)
    122123         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
    … …  
    135136         j_proche = (ij_proche-1)/imdep + 1
    136137         i_proche = ij_proche - (j_proche-1)*imdep
    137          PRINT*, "solution:", ij_proche, i_proche, j_proche
     138         if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche,
     139     $        j_proche
    138140         sortie(i,j) = entree(i_proche,j_proche)
    139141         ENDIF
    … …  
    258260            PRINT*, 'Probleme grave,i,j,indx,indy=',
    259261     .              i,j,indx(i,j),indy(i,j)
    260             CALL abort_gcm("", "", 1)
     262            call abort_gcm("", "", 1)
    261263         ENDIF
    262264      ENDDO
    … …  
    449451      REAL zzmin
    450452#endif
     453      include "iniprint.h"
    451454c
    452455      IF (imar.GT.400 .OR. jmar.GT.400) THEN
    … …  
    512515            sortie(i,j) = EXP(sortie(i,j))
    513516         ELSE
    514             PRINT*, 'probleme,i,j=', i,j
     517            if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j
    515518ccc            CALL ABORT_GCM("", "", 1)
    516519         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
    … …  
    529532         j_proche = (ij_proche-1)/imdep + 1
    530533         i_proche = ij_proche - (j_proche-1)*imdep
    531          PRINT*, "solution:", ij_proche, i_proche, j_proche
     534         if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche,
     535     $        j_proche
    532536         sortie(i,j) = entree(i_proche,j_proche)
    533537         ENDIF
    … …  
    574578      REAL zzmin
    575579#endif
     580      include "iniprint.h"
    576581c
    577582      IF (imar.GT.400 .OR. jmar.GT.400) THEN
    … …  
    641646           ENDIF
    642647         ELSE
    643            PRINT*, 'probleme,i,j=', i,j
     648           if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j
    644649ccc           CALL ABORT_GCM("", "", 1)
    645650         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
    … …  
    658663         j_proche = (ij_proche-1)/imdep + 1
    659664         i_proche = ij_proche - (j_proche-1)*imdep
    660          PRINT*, "solution:", ij_proche, i_proche, j_proche
     665         if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche,
     666     $        j_proche
    661667         IF (NINT(glace01(i_proche,j_proche)).EQ.1 ) THEN
    662668            frac_ice(i,j) = 1.0
    … …  
    710716      INTEGER i_proche, j_proche, ij_proche
    711717c
     718      include "iniprint.h"
     719
    712720      IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN
    713721         PRINT*, 'immod ou jmmod trop grand', immod, jmmod
    … …  
    874882         rugs(i,j) = EXP(rugs(i,j))
    875883         ELSE
    876          PRINT*, 'probleme,i,j=', i,j
     884         if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j
    877885ccc         CALL ABORT_GCM("", "", 1)
    878886         CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans)
    … …  
    891899         j_proche = (ij_proche-1)/imtmp + 1
    892900         i_proche = ij_proche - (j_proche-1)*imtmp
    893          PRINT*, "solution:", ij_proche, i_proche, j_proche
     901         if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche,
     902     $        j_proche
    894903         rugs(i,j) = LOG(MAX(0.001_8,cham2tmp(i_proche,j_proche)))
    895904         ENDIF
    … …  
    927936c
    928937      SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,im,jm,distance)
     938      IMPLICIT NONE
    929939c
    930940c Auteur: Laurent Li (le 30 decembre 1996)
    … …  
    949959      REAL radius
    950960      PARAMETER (radius=6371229.)
     961      INTEGER i,j
    951962c
    952963      pi = 4.0 * ATAN(1.0)

  • trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90

    r1300 r1391  
    55! nqtot : total number of tracers and higher order of moment, water vapor and liquid included
    66  INTEGER, SAVE :: nqtot
     7! CR: add number of tracers for water (for Earth model only!!)
     8  INTEGER, SAVE :: nqo
    79
    810! nbtr : number of tracers not including higher order of moment or water vapor or liquid
    … …  
    2729
    2830  CHARACTER(len=4),SAVE :: type_trac
     31  CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym
    2932 
    3033CONTAINS
    … …  
    6063
    6164    CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
    62     CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tracnam ! name from INCA
    6365    CHARACTER(len=3), DIMENSION(30) :: descrq
    6466    CHARACTER(len=1), DIMENSION(3)  :: txts
    … …  
    9496       WRITE(lunout,*) 'You have choosen to couple with INCA chemestry model : type_trac=', &
    9597            type_trac,' config_inca=',config_inca
    96        IF (config_inca/='aero' .AND. config_inca/='chem') THEN
     98       IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN
    9799          WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
    98100          CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
    … …  
    179181!
    180182    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue))
    181     ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), tracnam(nbtr))
     183    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
    182184    conv_flg(:) = 1 ! convection activated for all tracers
    183185    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
    … …  
    240242       END IF
    241243       
     244!CR: nombre de traceurs de l eau
     245       if (tnom_0(3) == 'H2Oi') then
     246          nqo=3
     247       else
     248          nqo=2
     249       endif
     250
    242251       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
    243252       WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
    … …  
    262271
    263272       DO iq =3,nqtrue
    264           tnom_0(iq)=tracnam(iq-2)
     273          tnom_0(iq)=solsym(iq-2)
    265274       END DO
     275       nqo = 2
    266276
    267277     END IF ! type_trac
    … …  
    430440!
    431441    DEALLOCATE(tnom_0, hadv, vadv)
    432     DEALLOCATE(tracnam)
     442
    433443
    434444  END SUBROUTINE infotrac_init

  • trunk/LMDZ.COMMON/libf/dyn3d_common/iniacademic.F90

    r1302 r1391  
    44SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
    55
    6   USE filtreg_mod
     6  USE filtreg_mod, ONLY: inifilr
    77  USE infotrac, ONLY : nqtot
    88  USE control_mod, ONLY: day_step,planet_type
    99#ifdef CPP_IOIPSL
    10   USE IOIPSL
     10  USE IOIPSL, ONLY: getin
    1111#else
    1212  ! if not using IOIPSL, we still need to use (a local version of) getin
    13   USE ioipsl_getincom
     13  USE ioipsl_getincom, ONLY: getin
    1414#endif
    1515  USE Write_Field
    … …  
    4040  !   ----------
    4141
    42   real time_0
    43 
    44   !   variables dynamiques
    45   REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    46   REAL teta(ip1jmp1,llm)                 ! temperature potentielle
    47   REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
    48   REAL ps(ip1jmp1)                       ! pression  au sol
    49   REAL masse(ip1jmp1,llm)                ! masse d'air
    50   REAL phis(ip1jmp1)                     ! geopotentiel au sol
     42  REAL,INTENT(OUT) :: time_0
     43
     44  !   fields
     45  REAL,INTENT(OUT) :: vcov(ip1jm,llm) ! meridional covariant wind
     46  REAL,INTENT(OUT) :: ucov(ip1jmp1,llm) ! zonal covariant wind
     47  REAL,INTENT(OUT) :: teta(ip1jmp1,llm) ! potential temperature (K)
     48  REAL,INTENT(OUT) :: q(ip1jmp1,llm,nqtot) ! advected tracers (.../kg_of_air)
     49  REAL,INTENT(OUT) :: ps(ip1jmp1) ! surface pressure (Pa)
     50  REAL,INTENT(OUT) :: masse(ip1jmp1,llm) ! air mass in grid cell (kg)
     51  REAL,INTENT(OUT) :: phis(ip1jmp1) ! surface geopotential
    5152
    5253  !   Local:
    … …  
    7677  character(len=80) :: abort_message
    7778
     79
     80  ! Sanity check: verify that options selected by user are not incompatible
     81  if ((iflag_phys==1).and. .not. read_start) then
     82    write(lunout,*) trim(modname)," error: if read_start is set to ", &
     83    " false then iflag_phys should not be 1"
     84    write(lunout,*) "You most likely want an aquaplanet initialisation", &
     85    " (iflag_phys >= 100)"
     86    call abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.false.",1)
     87  endif
     88 
    7889  !-----------------------------------------------------------------------
    7990  ! 1. Initializations for Earth-like case

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

    r1300 r1391  
    2929      real   masse(iip1,jjp1,llm)
    3030      real   massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)     
    31       real   w(iip1,jjp1,llm+1)
     31      real   w(iip1,jjp1,llm)
    3232      real   fluxwppm(iim,jjp1,llm)
    3333      real   pbaru(iip1,jjp1,llm )

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

    r1300 r1391  
    11!
    2 ! $Id: juldate.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: juldate.F 2197 2015-02-09 07:13:05Z emillour $
    33!
    44        subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
    … …  
    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

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

    r1300 r1391  
    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

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

    r1300 r1391  
    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

  • 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

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

    r1300 r1391  
    11!
    2 ! $Id: ran1.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: ran1.F 2197 2015-02-09 07:13:05Z emillour $
    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

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

    r1300 r1391  
    11!
    2 ! $Id: sortvarc.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: sortvarc.F 2083 2014-07-09 14:43:31Z emillour $
    33!
    44      SUBROUTINE sortvarc
    … …  
    66     $ vcov )
    77
    8       use control_mod,only:resetvarc
     8      USE control_mod, ONLY: resetvarc
    99      IMPLICIT NONE
     10
    1011
    1112c=======================================================================
    … …  
    2425c   -------------
    2526
    26 #include "dimensions.h"
    27 #include "paramet.h"
    28 #include "comconst.h"
    29 #include "comvert.h"
    30 #include "comgeom.h"
    31 #include "ener.h"
    32 #include "logic.h"
    33 #include "temps.h"
     27      INCLUDE "dimensions.h"
     28      INCLUDE "paramet.h"
     29      INCLUDE "comconst.h"
     30      INCLUDE "comvert.h"
     31      INCLUDE "comgeom.h"
     32      INCLUDE "ener.h"
     33      INCLUDE "logic.h"
     34      INCLUDE "temps.h"
     35      INCLUDE "iniprint.h"
    3436
    3537c   Arguments:
    3638c   ----------
    3739
    38       INTEGER itau
    39       REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
    40       REAL vcov(ip1jm,llm)
    41       REAL ps(ip1jmp1),phis(ip1jmp1)
    42       REAL vorpot(ip1jm,llm)
    43       REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
    44       REAL dp(ip1jmp1)
    45       REAL time
    46       REAL pk(ip1jmp1,llm)
     40      INTEGER,INTENT(IN) :: itau
     41      REAL,INTENT(IN) :: ucov(ip1jmp1,llm)
     42      REAL,INTENT(IN) :: teta(ip1jmp1,llm)
     43      REAL,INTENT(IN) :: masse(ip1jmp1,llm)
     44      REAL,INTENT(IN) :: vcov(ip1jm,llm)
     45      REAL,INTENT(IN) :: ps(ip1jmp1)
     46      REAL,INTENT(IN) :: phis(ip1jmp1)
     47      REAL,INTENT(IN) :: vorpot(ip1jm,llm)
     48      REAL,INTENT(IN) :: phi(ip1jmp1,llm)
     49      REAL,INTENT(IN) :: bern(ip1jmp1,llm)
     50      REAL,INTENT(IN) :: dp(ip1jmp1)
     51      REAL,INTENT(IN) :: time
     52      REAL,INTENT(IN) :: pk(ip1jmp1,llm)
    4753
    4854c   Local:
    … …  
    5763
    5864      REAL       SSUM
    59 
    60       logical  firstcal
    61       data     firstcal/.true./
    62       save     firstcal
     65      LOGICAL,SAVE :: firstcal=.true.
     66      CHARACTER(LEN=*),PARAMETER :: modname="sortvarc"
    6367
    6468c-----------------------------------------------------------------------
    … …  
    143147
    144148      IF (firstcal.and.resetvarc) then
    145          PRINT 3500, itau, rjour, heure,time
    146          PRINT*,'WARNING!!! On recalcule les valeurs initiales de :'
    147          PRINT*,'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang'
    148          PRINT *, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
     149         WRITE(lunout,3500) itau, rjour, heure, time
     150         WRITE(lunout,*) trim(modname),
     151     &     ' WARNING!!! Recomputing initial values of : '
     152         WRITE(lunout,*) 'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang'
     153         WRITE(lunout,*) ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
    149154         etot0 = etot
    150155         ptot0 = ptot
    … …  
    185190      firstcal = .false.
    186191
    187       PRINT 3500, itau, rjour, heure, time
    188       PRINT 4000, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
    189 
    190       RETURN
     192      WRITE(lunout,3500) itau, rjour, heure, time
     193      WRITE(lunout,4000) ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
    191194
    1921953500   FORMAT(10("*"),4x,'pas',i7,5x,'jour',f9.0,'heure',f5.1,4x
Note: See TracChangeset for help on using the changeset viewer.