Ignore:
Timestamp:
Mar 20, 2014, 10:57:19 AM (10 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r1920:1997 into testing branch

Location:
LMDZ5/branches/testing
Files:
124 deleted
14 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/dyn3d/addfi.F

    r1910 r1999  
    5555c    -----------
    5656c
    57       REAL pdt
     57      REAL,INTENT(IN) :: pdt ! time step for the integration (s)
    5858c
    59       REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
    60       REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nqtot),pps(ip1jmp1)
     59      REAL,INTENT(INOUT) :: pvcov(ip1jm,llm) ! covariant meridional wind
     60      REAL,INTENT(INOUT) :: pucov(ip1jmp1,llm) ! covariant zonal wind
     61      REAL,INTENT(INOUT) :: pteta(ip1jmp1,llm) ! potential temperature
     62      REAL,INTENT(INOUT) :: pq(ip1jmp1,llm,nqtot) ! tracers
     63      REAL,INTENT(INOUT) :: pps(ip1jmp1) ! surface pressure (Pa)
     64c respective tendencies (.../s) to add
     65      REAL,INTENT(IN) :: pdvfi(ip1jm,llm)
     66      REAL,INTENT(IN) :: pdufi(ip1jmp1,llm)
     67      REAL,INTENT(IN) :: pdqfi(ip1jmp1,llm,nqtot)
     68      REAL,INTENT(IN) :: pdhfi(ip1jmp1,llm)
     69      REAL,INTENT(IN) :: pdpfi(ip1jmp1)
    6170c
    62       REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)
    63       REAL pdqfi(ip1jmp1,llm,nqtot),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
    64 c
    65       LOGICAL leapf,forward
     71      LOGICAL,INTENT(IN) :: leapf,forward ! not used
    6672c
    6773c
    … …  
    7177      REAL xpn(iim),xps(iim),tpn,tps
    7278      INTEGER j,k,iq,ij
    73       REAL qtestw, qtestt
    74       PARAMETER ( qtestw = 1.0e-15 )
    75       PARAMETER ( qtestt = 1.0e-40 )
     79      REAL,PARAMETER :: qtestw = 1.0e-15
     80      REAL,PARAMETER :: qtestt = 1.0e-40
    7681
    7782      REAL SSUM

  • LMDZ5/branches/testing/libf/dyn3d/advtrac.F90

    r1910 r1999  
    99  !            M.A Filiberti (04/2002)
    1010  !
    11   USE infotrac
    12   USE control_mod
     11  USE infotrac, ONLY: nqtot, iadv
     12  USE control_mod, ONLY: iapp_tracvl, day_step
    1313
    1414
    … …  
    3030  !     Arguments
    3131  !-------------------------------------------------------------------
     32  INTEGER,INTENT(OUT) :: iapptrac
     33  REAL,INTENT(IN) :: pbaru(ip1jmp1,llm)
     34  REAL,INTENT(IN) :: pbarv(ip1jm,llm)
     35  REAL,INTENT(INOUT) :: q(ip1jmp1,llm,nqtot)
     36  REAL,INTENT(IN) :: masse(ip1jmp1,llm)
     37  REAL,INTENT(IN) :: p( ip1jmp1,llmp1 )
     38  REAL,INTENT(IN) :: teta(ip1jmp1,llm)
     39  REAL,INTENT(IN) :: pk(ip1jmp1,llm)
     40  REAL,INTENT(OUT) :: flxw(ip1jmp1,llm)
     41  !-------------------------------------------------------------------
    3242  !     Ajout PPM
    3343  !--------------------------------------------------------
    3444  REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm)
    35   !--------------------------------------------------------
    36   INTEGER iapptrac
    37   REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
    38   REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
    39   REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
    40   REAL pk(ip1jmp1,llm)
    41   REAL flxw(ip1jmp1,llm)
    42 
    4345  !-------------------------------------------------------------
    4446  !     Variables locales

  • LMDZ5/branches/testing/libf/dyn3d/caldyn.F

    r1910 r1999  
    11!
    2 ! $Header$
     2! $Id$
    33!
    4 c
    5 c
    64      SUBROUTINE caldyn
    75     $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
    … …  
    108      IMPLICIT NONE
    119
    12 c=======================================================================
    13 c
    14 c  Auteur :  P. Le Van
    15 c
    16 c   Objet:
    17 c   ------
    18 c
    19 c   Calcul des tendances dynamiques.
    20 c
    21 c Modif 04/93 F.Forget
    22 c=======================================================================
     10!=======================================================================
     11!
     12!  Auteur :  P. Le Van
     13!
     14!   Objet:
     15!   ------
     16!
     17!   Calcul des tendances dynamiques.
     18!
     19! Modif 04/93 F.Forget
     20!=======================================================================
    2321
    24 c-----------------------------------------------------------------------
    25 c   0. Declarations:
    26 c   ----------------
     22!-----------------------------------------------------------------------
     23!   0. Declarations:
     24!   ----------------
    2725
    2826#include "dimensions.h"
    … …  
    3230#include "comgeom.h"
    3331
    34 c   Arguments:
    35 c   ----------
     32!   Arguments:
     33!   ----------
    3634
    37       LOGICAL conser
     35      LOGICAL,INTENT(IN) :: conser ! triggers printing some diagnostics
     36      INTEGER,INTENT(IN) :: itau ! time step index
     37      REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind
     38      REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind
     39      REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potential temperature
     40      REAL,INTENT(IN) :: ps(ip1jmp1) ! surface pressure
     41      REAL,INTENT(IN) :: phis(ip1jmp1) ! geopotential at the surface
     42      REAL,INTENT(IN) :: pk(ip1jmp1,llm) ! Exner at mid-layer
     43      REAL,INTENT(IN) :: pkf(ip1jmp1,llm) ! filtered Exner
     44      REAL,INTENT(IN) :: phi(ip1jmp1,llm) ! geopotential
     45      REAL,INTENT(OUT) :: masse(ip1jmp1,llm) ! air mass
     46      REAL,INTENT(OUT) :: dv(ip1jm,llm) ! tendency on vcov
     47      REAL,INTENT(OUT) :: du(ip1jmp1,llm) ! tendency on ucov
     48      REAL,INTENT(OUT) :: dteta(ip1jmp1,llm) ! tenddency on teta
     49      REAL,INTENT(OUT) :: dp(ip1jmp1) ! tendency on ps
     50      REAL,INTENT(OUT) :: w(ip1jmp1,llm) ! vertical velocity
     51      REAL,INTENT(OUT) :: pbaru(ip1jmp1,llm) ! mass flux in the zonal direction
     52      REAL,INTENT(OUT) :: pbarv(ip1jm,llm) ! mass flux in the meridional direction
     53      REAL,INTENT(IN) :: time ! current time
    3854
    39       INTEGER itau
    40       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    41       REAL ps(ip1jmp1),phis(ip1jmp1)
    42       REAL pk(iip1,jjp1,llm),pkf(ip1jmp1,llm)
     55!   Local:
     56!   ------
     57
    4358      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
    44       REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
    45       REAL dv(ip1jm,llm),du(ip1jmp1,llm)
    46       REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
    47       REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
    48       REAL time
    49 
    50 c   Local:
    51 c   ------
    52 
    5359      REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
    5460      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
    5561      REAL vorpot(ip1jm,llm)
    56       REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
     62      REAL ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
    5763      REAL bern(ip1jmp1,llm)
    5864      REAL massebxy(ip1jm,llm)
    … …  
    6167      INTEGER   ij,l
    6268
    63 c-----------------------------------------------------------------------
    64 c   Calcul des tendances dynamiques:
    65 c   --------------------------------
     69!-----------------------------------------------------------------------
     70!   Compute dynamical tendencies:
     71!--------------------------------
    6672
     73      ! compute contravariant winds ucont() and vcont
    6774      CALL covcont  ( llm    , ucov    , vcov , ucont, vcont        )
     75      ! compute pressure p()
    6876      CALL pression ( ip1jmp1, ap      , bp   ,  ps  , p            )
     77      ! compute psexbarxy() XY-area weighted-averaged surface pressure (what for?)
    6978      CALL psextbar (   ps   , psexbarxy                            )
     79      ! compute mass in each atmospheric mesh: masse()
    7080      CALL massdair (    p   , masse                                )
     81      ! compute X and Y-averages of mass, massebx() and masseby()
    7182      CALL massbar  (   masse, massebx , masseby                    )
     83      ! compute XY-average of mass, massebxy()
    7284      call massbarxy(   masse, massebxy                             )
     85      ! compute mass fluxes pbaru() and pbarv()
    7386      CALL flumass  ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
     87      ! compute dteta() , horizontal converging flux of theta
    7488      CALL dteta1   (   teta , pbaru   , pbarv, dteta               )
     89      ! compute convm(), horizontal converging flux of mass
    7590      CALL convmas  (   pbaru, pbarv   , convm                      )
    7691
     92      ! compute pressure variation due to mass convergence
    7793      DO ij =1, ip1jmp1
    7894         dp( ij ) = convm( ij,1 ) / airesurg( ij )
    7995      ENDDO
    8096
     97      ! compute vertical velocity w()
    8198      CALL vitvert ( convm  , w                                  )
     99      ! compute potential vorticity vorpot()
    82100      CALL tourpot ( vcov   , ucov  , massebxy  , vorpot         )
     101      ! compute rotation induced du() and dv()
    83102      CALL dudv1   ( vorpot , pbaru , pbarv     , du     , dv    )
     103      ! compute kinetic energy ecin()
    84104      CALL enercin ( vcov   , ucov  , vcont     , ucont  , ecin  )
     105      ! compute Bernouilli function bern()
    85106      CALL bernoui ( ip1jmp1, llm   , phi       , ecin   , bern  )
     107      ! compute and add du() and dv() contributions from Bernouilli and pressure
    86108      CALL dudv2   ( teta   , pkf   , bern      , du     , dv    )
    87109
    … …  
    90112         DO ij=1,ip1jmp1
    91113            ang(ij,l) = ucov(ij,l) + constang(ij)
    92       ENDDO
     114         ENDDO
    93115      ENDDO
    94116
    95 
     117      ! compute vertical advection contributions to du(), dv() and dteta()
    96118      CALL advect( ang, vcov, teta, w, massebx, masseby, du, dv,dteta )
    97119
    98 C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
    99 C          probablement. Observe sur le code compile avec pgf90 3.0-1
     120!  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
     121!          probablement. Observe sur le code compile avec pgf90 3.0-1
    100122
    101123      DO l = 1, llm
    102124         DO ij = 1, ip1jm, iip1
    103125           IF( dv(ij,l).NE.dv(ij+iim,l) )  THEN
    104 c         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', 
    105 c    ,   ' dans caldyn'
    106 c         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
     126!         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', 
     127!    ,   ' dans caldyn'
     128!         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
    107129          dv(ij+iim,l) = dv(ij,l)
    108           endif
    109          enddo
    110       enddo
    111 c-----------------------------------------------------------------------
    112 c   Sorties eventuelles des variables de controle:
    113 c   ----------------------------------------------
     130           ENDIF
     131         ENDDO
     132      ENDDO
     133
     134!-----------------------------------------------------------------------
     135!   Output some control variables:
     136!---------------------------------
    114137
    115138      IF( conser )  THEN
    116139        CALL sortvarc
    117      $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
    118 
     140     & ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
    119141      ENDIF
    120142
    121       RETURN
    122143      END

  • LMDZ5/branches/testing/libf/dyn3d/calfis.F

    r1910 r1999  
    3030c    Auteur :  P. Le Van, F. Hourdin
    3131c   .........
    32       USE infotrac
    33       USE control_mod
     32      USE infotrac, ONLY: nqtot, niadv, tname
     33      USE control_mod, ONLY: planet_type, nsplit_phys
    3434 
    3535
    … …  
    102102c    Arguments :
    103103c    -----------
    104       LOGICAL  lafin
    105 
    106 
    107       REAL pvcov(iip1,jjm,llm)
    108       REAL pucov(iip1,jjp1,llm)
    109       REAL pteta(iip1,jjp1,llm)
    110       REAL pmasse(iip1,jjp1,llm)
    111       REAL pq(iip1,jjp1,llm,nqtot)
    112       REAL pphis(iip1,jjp1)
    113       REAL pphi(iip1,jjp1,llm)
    114 c
    115       REAL pdvcov(iip1,jjm,llm)
    116       REAL pducov(iip1,jjp1,llm)
    117       REAL pdteta(iip1,jjp1,llm)
    118       REAL pdq(iip1,jjp1,llm,nqtot)
    119 c
    120       REAL pps(iip1,jjp1)
    121       REAL pp(iip1,jjp1,llmp1)
    122       REAL ppk(iip1,jjp1,llm)
    123 c
    124       REAL pdvfi(iip1,jjm,llm)
    125       REAL pdufi(iip1,jjp1,llm)
    126       REAL pdhfi(iip1,jjp1,llm)
    127       REAL pdqfi(iip1,jjp1,llm,nqtot)
    128       REAL pdpsfi(iip1,jjp1)
    129 
    130       INTEGER        longcles
    131       PARAMETER    ( longcles = 20 )
    132       REAL clesphy0( longcles )
     104      LOGICAL,INTENT(IN) ::  lafin ! .true. for the very last call to physics
     105      REAL,INTENT(IN):: jD_cur, jH_cur
     106      REAL,INTENT(IN) :: pvcov(iip1,jjm,llm) ! covariant meridional velocity
     107      REAL,INTENT(IN) :: pucov(iip1,jjp1,llm) ! covariant zonal velocity
     108      REAL,INTENT(IN) :: pteta(iip1,jjp1,llm) ! potential temperature
     109      REAL,INTENT(IN) :: pmasse(iip1,jjp1,llm) ! mass in each cell ! not used
     110      REAL,INTENT(IN) :: pq(iip1,jjp1,llm,nqtot) ! tracers
     111      REAL,INTENT(IN) :: pphis(iip1,jjp1) ! surface geopotential
     112      REAL,INTENT(IN) :: pphi(iip1,jjp1,llm) ! geopotential
     113
     114      REAL,INTENT(IN) :: pdvcov(iip1,jjm,llm) ! dynamical tendency on vcov
     115      REAL,INTENT(IN) :: pducov(iip1,jjp1,llm) ! dynamical tendency on ucov
     116      REAL,INTENT(IN) :: pdteta(iip1,jjp1,llm) ! dynamical tendency on teta
     117      ! NB: pdteta is used only to compute pcvgt which is in fact not used...
     118      REAL,INTENT(IN) :: pdq(iip1,jjp1,llm,nqtot) ! dynamical tendency on tracers
     119      ! NB: pdq is only used to compute pcvgq which is in fact not used...
     120
     121      REAL,INTENT(IN) :: pps(iip1,jjp1) ! surface pressure (Pa)
     122      REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa)
     123      REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer
     124      REAL,INTENT(IN) :: flxw(iip1,jjp1,llm)  ! Vertical mass flux on dynamics grid
     125
     126      ! tendencies (in */s) from the physics
     127      REAL,INTENT(OUT) :: pdvfi(iip1,jjm,llm) ! tendency on covariant meridional wind
     128      REAL,INTENT(OUT) :: pdufi(iip1,jjp1,llm) ! tendency on covariant zonal wind
     129      REAL,INTENT(OUT) :: pdhfi(iip1,jjp1,llm) ! tendency on potential temperature (K/s)
     130      REAL,INTENT(OUT) :: pdqfi(iip1,jjp1,llm,nqtot) ! tendency on tracers
     131      REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s)
     132
     133      INTEGER,PARAMETER :: longcles = 20
     134      REAL,INTENT(IN) :: clesphy0( longcles ) ! unused
    133135
    134136
    … …  
    162164c
    163165cIM diagnostique PVteta, Amip2
    164       INTEGER ntetaSTD
    165       PARAMETER(ntetaSTD=3)
    166       REAL rtetaSTD(ntetaSTD)
    167       DATA rtetaSTD/350., 380., 405./ ! Earth-specific values, beware !!
     166      INTEGER,PARAMETER :: ntetaSTD=3
     167      REAL,SAVE :: rtetaSTD(ntetaSTD)=(/350.,380.,405./) ! Earth-specific, beware !!
    168168      REAL PVteta(ngridmx,ntetaSTD)
    169169c
    170       REAL flxw(iip1,jjp1,llm)  ! Flux de masse verticale sur la grille dynamique
    171170      REAL flxwfi(ngridmx,llm)  ! Flux de masse verticale sur la grille physiq
    172171c
    … …  
    174173      REAL SSUM
    175174
    176       LOGICAL firstcal, debut
    177       DATA firstcal/.true./
    178       SAVE firstcal,debut
     175      LOGICAL,SAVE :: firstcal=.true., debut=.true.
    179176!      REAL rdayvrai
    180       REAL, intent(in):: jD_cur, jH_cur
    181177
    182178      LOGICAL tracerdyn

  • LMDZ5/branches/testing/libf/dyn3d/ce0l.F90

    r1910 r1999  
    9494  END IF
    9595
    96   IF (grilles_gcm_netcdf) THEN
    97      WRITE(lunout,'(//)')
    98      WRITE(lunout,*) '  ***************************  '
    99      WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
    100      WRITE(lunout,*) '  ***************************  '
    101      WRITE(lunout,'(//)')
    102      CALL grilles_gcm_netcdf_sub(masque,phis)
    103   END IF
     96 
     97  WRITE(lunout,'(//)')
     98  WRITE(lunout,*) '  ***************************  '
     99  WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
     100  WRITE(lunout,*) '  ***************************  '
     101  WRITE(lunout,'(//)')
     102  CALL grilles_gcm_netcdf_sub(masque,phis)
     103
    104104#endif
    105105! of #ifndef CPP_EARTH #else

  • LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F

    r1910 r1999  
    890890      ok_etat0 = .TRUE.
    891891      CALL getin('ok_etat0',ok_etat0)
    892 
    893 !Config  Key  = grilles_gcm_netcdf
    894 !Config  Desc = creation de fichier grilles_gcm.nc dans create_etat0_limit
    895 !Config  Def  = n
    896       grilles_gcm_netcdf = .FALSE.
    897       CALL getin('grilles_gcm_netcdf',grilles_gcm_netcdf)
    898892
    899893      write(lunout,*)' #########################################'
    … …  
    943937      write(lunout,*)' ok_limit = ', ok_limit
    944938      write(lunout,*)' ok_etat0 = ', ok_etat0
    945       write(lunout,*)' grilles_gcm_netcdf = ', grilles_gcm_netcdf
    946939c
    947940      RETURN

  • LMDZ5/branches/testing/libf/dyn3d/dissip.F

    r1910 r1999  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
    … …  
    3535c   ----------
    3636
    37       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    38       REAL  p( ip1jmp1,llmp1 )
    39       REAL dv(ip1jm,llm),du(ip1jmp1,llm),dh(ip1jmp1,llm)
     37      REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind
     38      REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind
     39      REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potential temperature
     40      REAL,INTENT(IN) :: p(ip1jmp1,llmp1) ! pressure
     41      ! tendencies (.../s) on covariant winds and potential temperature
     42      REAL,INTENT(OUT) :: dv(ip1jm,llm)
     43      REAL,INTENT(OUT) :: du(ip1jmp1,llm)
     44      REAL,INTENT(OUT) :: dh(ip1jmp1,llm)
    4045
    4146c   Local:

  • LMDZ5/branches/testing/libf/dyn3d/dynetat0.F

    r1910 r1999  
    6767        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
    6868        write(lunout,*)' ierr = ', ierr
    69         CALL ABORT
     69        CALL ABORT_gcm("dynetat0", "", 1)
    7070      ENDIF
    7171
    … …  
    7474      IF (ierr .NE. NF_NOERR) THEN
    7575         write(lunout,*)"dynetat0: Le champ <controle> est absent"
    76          CALL abort
     76         CALL ABORT_gcm("dynetat0", "", 1)
    7777      ENDIF
    7878      ierr = nf90_get_var(nid, nvarid, tab_cntrl)
    7979      IF (ierr .NE. NF_NOERR) THEN
    8080         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
    81          CALL abort
     81         CALL ABORT_gcm("dynetat0", "", 1)
    8282      ENDIF
    8383
    … …  
    154154      IF (ierr .NE. NF_NOERR) THEN
    155155         write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
    156          CALL abort
     156         CALL ABORT_gcm("dynetat0", "", 1)
    157157      ENDIF
    158158      ierr = nf90_get_var(nid, nvarid, rlonu)
    159159      IF (ierr .NE. NF_NOERR) THEN
    160160         write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
    161          CALL abort
     161         CALL ABORT_gcm("dynetat0", "", 1)
    162162      ENDIF
    163163
    … …  
    165165      IF (ierr .NE. NF_NOERR) THEN
    166166         write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
    167          CALL abort
     167         CALL ABORT_gcm("dynetat0", "", 1)
    168168      ENDIF
    169169      ierr = nf90_get_var(nid, nvarid, rlatu)
    170170      IF (ierr .NE. NF_NOERR) THEN
    171171         write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
    172          CALL abort
     172         CALL ABORT_gcm("dynetat0", "", 1)
    173173      ENDIF
    174174
    … …  
    176176      IF (ierr .NE. NF_NOERR) THEN
    177177         write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
    178          CALL abort
     178         CALL ABORT_gcm("dynetat0", "", 1)
    179179      ENDIF
    180180      ierr = nf90_get_var(nid, nvarid, rlonv)
    181181      IF (ierr .NE. NF_NOERR) THEN
    182182         write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
    183          CALL abort
     183         CALL ABORT_gcm("dynetat0", "", 1)
    184184      ENDIF
    185185
    … …  
    187187      IF (ierr .NE. NF_NOERR) THEN
    188188         write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
    189          CALL abort
     189         CALL ABORT_gcm("dynetat0", "", 1)
    190190      ENDIF
    191191      ierr = nf90_get_var(nid, nvarid, rlatv)
    192192      IF (ierr .NE. NF_NOERR) THEN
    193193         write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
    194          CALL abort
     194         CALL ABORT_gcm("dynetat0", "", 1)
    195195      ENDIF
    196196
    … …  
    198198      IF (ierr .NE. NF_NOERR) THEN
    199199         write(lunout,*)"dynetat0: Le champ <cu> est absent"
    200          CALL abort
     200         CALL ABORT_gcm("dynetat0", "", 1)
    201201      ENDIF
    202202      ierr = nf90_get_var(nid, nvarid, cu)
    203203      IF (ierr .NE. NF_NOERR) THEN
    204204         write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
    205          CALL abort
     205         CALL ABORT_gcm("dynetat0", "", 1)
    206206      ENDIF
    207207
    … …  
    209209      IF (ierr .NE. NF_NOERR) THEN
    210210         write(lunout,*)"dynetat0: Le champ <cv> est absent"
    211          CALL abort
     211         CALL ABORT_gcm("dynetat0", "", 1)
    212212      ENDIF
    213213      ierr = nf90_get_var(nid, nvarid, cv)
    214214      IF (ierr .NE. NF_NOERR) THEN
    215215         write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
    216          CALL abort
     216         CALL ABORT_gcm("dynetat0", "", 1)
    217217      ENDIF
    218218
    … …  
    220220      IF (ierr .NE. NF_NOERR) THEN
    221221         write(lunout,*)"dynetat0: Le champ <aire> est absent"
    222          CALL abort
     222         CALL ABORT_gcm("dynetat0", "", 1)
    223223      ENDIF
    224224      ierr = nf90_get_var(nid, nvarid, aire)
    225225      IF (ierr .NE. NF_NOERR) THEN
    226226         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
    227          CALL abort
     227         CALL ABORT_gcm("dynetat0", "", 1)
    228228      ENDIF
    229229
    … …  
    231231      IF (ierr .NE. NF_NOERR) THEN
    232232         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
    233          CALL abort
     233         CALL ABORT_gcm("dynetat0", "", 1)
    234234      ENDIF
    235235      ierr = nf90_get_var(nid, nvarid, phis)
    236236      IF (ierr .NE. NF_NOERR) THEN
    237237         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
    238          CALL abort
     238         CALL ABORT_gcm("dynetat0", "", 1)
    239239      ENDIF
    240240
    … …  
    246246         IF (ierr .NE. NF_NOERR) THEN
    247247            write(lunout,*)"dynetat0: Le champ <Time> est absent"
    248             CALL abort
     248            CALL ABORT_gcm("dynetat0", "", 1)
    249249         ENDIF
    250250      ENDIF
    … …  
    252252      IF (ierr .NE. NF_NOERR) THEN
    253253         write(lunout,*)"dynetat0: Lecture echouee <temps>"
    254          CALL abort
     254         CALL ABORT_gcm("dynetat0", "", 1)
    255255      ENDIF
    256256
    … …  
    258258      IF (ierr .NE. NF_NOERR) THEN
    259259         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
    260          CALL abort
     260         CALL ABORT_gcm("dynetat0", "", 1)
    261261      ENDIF
    262262      ierr = nf90_get_var(nid, nvarid, ucov)
    263263      IF (ierr .NE. NF_NOERR) THEN
    264264         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
    265          CALL abort
     265         CALL ABORT_gcm("dynetat0", "", 1)
    266266      ENDIF
    267267 
    … …  
    269269      IF (ierr .NE. NF_NOERR) THEN
    270270         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
    271          CALL abort
     271         CALL ABORT_gcm("dynetat0", "", 1)
    272272      ENDIF
    273273      ierr = nf90_get_var(nid, nvarid, vcov)
    274274      IF (ierr .NE. NF_NOERR) THEN
    275275         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
    276          CALL abort
     276         CALL ABORT_gcm("dynetat0", "", 1)
    277277      ENDIF
    278278
    … …  
    280280      IF (ierr .NE. NF_NOERR) THEN
    281281         write(lunout,*)"dynetat0: Le champ <teta> est absent"
    282          CALL abort
     282         CALL ABORT_gcm("dynetat0", "", 1)
    283283      ENDIF
    284284      ierr = nf90_get_var(nid, nvarid, teta)
    285285      IF (ierr .NE. NF_NOERR) THEN
    286286         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
    287          CALL abort
     287         CALL ABORT_gcm("dynetat0", "", 1)
    288288      ENDIF
    289289
    … …  
    301301          IF (ierr .NE. NF_NOERR) THEN
    302302            write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
    303             CALL abort
     303            CALL ABORT_gcm("dynetat0", "", 1)
    304304          ENDIF
    305305        ENDIF
    … …  
    310310      IF (ierr .NE. NF_NOERR) THEN
    311311         write(lunout,*)"dynetat0: Le champ <masse> est absent"
    312          CALL abort
     312         CALL ABORT_gcm("dynetat0", "", 1)
    313313      ENDIF
    314314      ierr = nf90_get_var(nid, nvarid, masse)
    315315      IF (ierr .NE. NF_NOERR) THEN
    316316         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
    317          CALL abort
     317         CALL ABORT_gcm("dynetat0", "", 1)
    318318      ENDIF
    319319
    … …  
    321321      IF (ierr .NE. NF_NOERR) THEN
    322322         write(lunout,*)"dynetat0: Le champ <ps> est absent"
    323          CALL abort
     323         CALL ABORT_gcm("dynetat0", "", 1)
    324324      ENDIF
    325325      ierr = nf90_get_var(nid, nvarid, ps)
    326326      IF (ierr .NE. NF_NOERR) THEN
    327327         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
    328          CALL abort
     328         CALL ABORT_gcm("dynetat0", "", 1)
    329329      ENDIF
    330330

  • LMDZ5/branches/testing/libf/dyn3d/dynredem.F

    r1910 r1999  
    133133     &                  //trim(fichnom)
    134134         write(lunout,*)' ierr = ', ierr
    135          CALL ABORT
     135         CALL ABORT_GCM("DYNREDEM0", "", 1)
    136136      ENDIF
    137137c
    … …  
    512512      IF (ierr .NE. NF_NOERR) THEN
    513513         write(lunout,*)"dynredem1: Pb. d ouverture "//trim(fichnom)
    514          CALL abort
     514         call abort_gcm("dynredem1", "", 1)
    515515      ENDIF
    516516

  • LMDZ5/branches/testing/libf/dyn3d/fxhyp.F

    r1910 r1999  
    178178        WRITE(6,*)'Modifier les valeurs de  grossismx ,tau ou dzoomx ',
    179179     , ' et relancer ! ***  '
    180         CALL ABORT
     180        CALL ABORT_GCM("FXHYP", "", 1)
    181181       ENDIF
    182182c
    … …  
    305305
    3063061500   CONTINUE
    307 
    308307
    309308

  • LMDZ5/branches/testing/libf/dyn3d/gcm.F

    r1910 r1999  
    327327          start_time = starttime
    328328        ELSE
    329           WRITE(lunout,*)'Je m''arrete'
    330           CALL abort
     329          call abort_gcm("gcm", "'Je m''arrete'", 1)
    331330        ENDIF
    332331      ENDIF

  • LMDZ5/branches/testing/libf/dyn3d/leapfrog.F

    r1910 r1999  
    1212      use IOIPSL
    1313#endif
    14       USE infotrac
     14      USE infotrac, ONLY: nqtot
    1515      USE guide_mod, ONLY : guide_main
    16       USE write_field
    17       USE control_mod
     16      USE write_field, ONLY: writefield
     17      USE control_mod, ONLY: nday, day_step, planet_type, offline,
     18     &                       iconser, iphysiq, iperiod, dissip_period,
     19     &                       iecri, ip_ebil_dyn, ok_dynzon, ok_dyn_ins,
     20     &                       periodav, ok_dyn_ave, output_grads_dyn
    1821      IMPLICIT NONE
    1922
    … …  
    6770! #include "clesphys.h"
    6871
    69       INTEGER         longcles
    70       PARAMETER     ( longcles = 20 )
    71       REAL  clesphy0( longcles )
     72      INTEGER,PARAMETER :: longcles = 20
     73      REAL,INTENT(IN) :: clesphy0( longcles ) ! not used
     74      REAL,INTENT(IN) :: time_0 ! not used
     75
     76c   dynamical variables:
     77      REAL,INTENT(INOUT) :: ucov(ip1jmp1,llm)    ! zonal covariant wind
     78      REAL,INTENT(INOUT) :: vcov(ip1jm,llm)      ! meridional covariant wind
     79      REAL,INTENT(INOUT) :: teta(ip1jmp1,llm)    ! potential temperature
     80      REAL,INTENT(INOUT) :: ps(ip1jmp1)          ! surface pressure (Pa)
     81      REAL,INTENT(INOUT) :: masse(ip1jmp1,llm)   ! air mass
     82      REAL,INTENT(INOUT) :: phis(ip1jmp1)        ! geopotentiat at the surface
     83      REAL,INTENT(INOUT) :: q(ip1jmp1,llm,nqtot) ! advected tracers
     84
     85      REAL p (ip1jmp1,llmp1  )               ! interlayer pressure
     86      REAL pks(ip1jmp1)                      ! exner at the surface
     87      REAL pk(ip1jmp1,llm)                   ! exner at mid-layer
     88      REAL pkf(ip1jmp1,llm)                  ! filtered exner at mid-layer
     89      REAL phi(ip1jmp1,llm)                  ! geopotential
     90      REAL w(ip1jmp1,llm)                    ! vertical velocity
    7291
    7392      real zqmin,zqmax
    74 
    75 c   variables dynamiques
    76       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    77       REAL teta(ip1jmp1,llm)                 ! temperature potentielle
    78       REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
    79       REAL ps(ip1jmp1)                       ! pression  au sol
    80       REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    81       REAL pks(ip1jmp1)                      ! exner au  sol
    82       REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
    83       REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
    84       REAL masse(ip1jmp1,llm)                ! masse d'air
    85       REAL phis(ip1jmp1)                     ! geopotentiel au sol
    86       REAL phi(ip1jmp1,llm)                  ! geopotentiel
    87       REAL w(ip1jmp1,llm)                    ! vitesse verticale
    8893
    8994c variables dynamiques intermediaire pour le transport
    … …  
    117122
    118123      REAL  SSUM
    119       REAL time_0
    120124!     REAL finvmaold(ip1jmp1,llm)
    121125
    … …  
    319323
    320324      IF( forward. OR . leapf )  THEN
    321 ! Ehouarn: NB: at this point p with ps are not synchronized
    322 !              (whereas mass and ps are...)
     325! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step
    323326         CALL caladvtrac(q,pbaru,pbarv,
    324327     *        p, masse, dq,  teta,
    … …  
    441444     $                  ucov, vcov, teta , q   ,ps ,
    442445     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
     446          ! since addfi updates ps(), also update p(), masse() and pk()
     447          CALL pression (ip1jmp1,ap,bp,ps,p)
     448          CALL massdair(p,masse)
     449          if (pressure_exner) then
     450            CALL exner_hyb(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
     451          else
     452            CALL exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
     453          endif
    443454
    444455         IF (ok_strato) THEN
    … …  
    499510          CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
    500511        endif
     512        CALL massdair(p,masse)
    501513
    502514

  • LMDZ5/branches/testing/libf/dyn3d/logic.h

    r1910 r1999  
    1111     &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus       &
    1212     &  ,read_start,ok_guide,ok_strato,ok_gradsfile                     &
    13      &  ,ok_limit,ok_etat0,grilles_gcm_netcdf,hybrid
     13     &  ,ok_limit,ok_etat0,hybrid
    1414
    1515      COMMON/logici/ iflag_phys,iflag_trac
    … …  
    1818     & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus                      &
    1919     &  ,read_start,ok_guide,ok_strato,ok_gradsfile                     &
    20      &  ,ok_limit,ok_etat0,grilles_gcm_netcdf
     20     &  ,ok_limit,ok_etat0
     21     
    2122      logical hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
    2223                     ! (only used if disvert_type==2)
Note: See TracChangeset for help on using the changeset viewer.