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

Merged trunk changes r1920:1997 into testing branch

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

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/dyn3dpar/addfi_p.F

    r1910 r1999  
    5555c    -----------
    5656c
    57       REAL pdt
    58 c
    59       REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
    60       REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nqtot),pps(ip1jmp1)
    61 c
    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
     57      REAL,INTENT(IN) :: pdt ! time step for the integration (s)
     58c
     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)
     70c
     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/dyn3dpar/advtrac_p.F90

    r1910 r1999  
    1616  USE Vampir
    1717  USE times
    18   USE infotrac
    19   USE control_mod
     18  USE infotrac, ONLY: nqtot, iadv
     19  USE control_mod, ONLY: iapp_tracvl, day_step, planet_type
    2020  IMPLICIT NONE
    2121  !
    … …  
    3434  !     Arguments
    3535  !-------------------------------------------------------------------
     36  INTEGER,INTENT(OUT) :: iapptrac
     37  REAL,INTENT(IN) :: pbaru(ip1jmp1,llm)
     38  REAL,INTENT(IN) :: pbarv(ip1jm,llm)
     39  REAL,INTENT(INOUT) :: q(ip1jmp1,llm,nqtot)
     40  REAL,INTENT(IN) :: masse(ip1jmp1,llm)
     41  REAL,INTENT(IN) :: p( ip1jmp1,llmp1 )
     42  REAL,INTENT(IN) :: teta(ip1jmp1,llm)
     43  REAL,INTENT(IN) :: pk(ip1jmp1,llm)
     44  REAL,INTENT(OUT) :: flxw(ip1jmp1,llm)
     45  !-------------------------------------------------------------------
    3646  !     Ajout PPM
    3747  !--------------------------------------------------------
    3848  REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm)
    39   !--------------------------------------------------------
    40   INTEGER iapptrac
    41   REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
    42   REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
    43   REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
    44   REAL pk(ip1jmp1,llm)
    45   REAL               :: flxw(ip1jmp1,llm)
    46 
    4749  !-------------------------------------------------------------
    4850  !     Variables locales

  • LMDZ5/branches/testing/libf/dyn3dpar/caldyn_p.F

    r1910 r1999  
    11!
    2 ! $Header$
    3 !
    4 c
    5 c
     2! $Id$
     3!
    64#undef DEBUG_IO
    7 c#define DEBUG_IO
     5!#define DEBUG_IO
    86
    97      SUBROUTINE caldyn_p
    … …  
    1513      IMPLICIT NONE
    1614
    17 c=======================================================================
    18 c
    19 c  Auteur :  P. Le Van
    20 c
    21 c   Objet:
    22 c   ------
    23 c
    24 c   Calcul des tendances dynamiques.
    25 c
    26 c Modif 04/93 F.Forget
    27 c=======================================================================
    28 
    29 c-----------------------------------------------------------------------
    30 c   0. Declarations:
    31 c   ----------------
     15!=======================================================================
     16!
     17!  Auteur :  P. Le Van
     18!
     19!   Objet:
     20!   ------
     21!
     22!   Calcul des tendances dynamiques.
     23!
     24! Modif 04/93 F.Forget
     25!=======================================================================
     26
     27!-----------------------------------------------------------------------
     28!   0. Declarations:
     29!   ----------------
    3230
    3331#include "dimensions.h"
    … …  
    3735#include "comgeom.h"
    3836
    39 c   Arguments:
    40 c   ----------
    41 
    42       LOGICAL conser
    43 
    44       INTEGER itau
    45       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    46       REAL ps(ip1jmp1),phis(ip1jmp1)
    47       REAL pk(iip1,jjp1,llm),pkf(ip1jmp1,llm)
     37!   Arguments:
     38!   ----------
     39
     40      LOGICAL,INTENT(IN) :: conser ! triggers printing some diagnostics
     41      INTEGER,INTENT(IN) :: itau ! time step index
     42      REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind
     43      REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind
     44      REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potential temperature
     45      REAL,INTENT(IN) :: ps(ip1jmp1) ! surface pressure
     46      REAL,INTENT(IN) :: phis(ip1jmp1) ! geopotential at the surface
     47      REAL,INTENT(IN) :: pk(ip1jmp1,llm) ! Exner at mid-layer
     48      REAL,INTENT(IN) :: pkf(ip1jmp1,llm) ! filtered Exner
     49      REAL,INTENT(IN) :: phi(ip1jmp1,llm) ! geopotential
     50      REAL,INTENT(OUT) :: masse(ip1jmp1,llm) ! air mass
     51      REAL,INTENT(OUT) :: dv(ip1jm,llm) ! tendency on vcov
     52      REAL,INTENT(OUT) :: du(ip1jmp1,llm) ! tendency on ucov
     53      REAL,INTENT(OUT) :: dteta(ip1jmp1,llm) ! tenddency on teta
     54      REAL,INTENT(OUT) :: dp(ip1jmp1) ! tendency on ps
     55      REAL,INTENT(OUT) :: w(ip1jmp1,llm) ! vertical velocity
     56      REAL,INTENT(OUT) :: pbaru(ip1jmp1,llm) ! mass flux in the zonal direction
     57      REAL,INTENT(OUT) :: pbarv(ip1jm,llm) ! mass flux in the meridional direction
     58      REAL,INTENT(IN) :: time ! current time
     59
     60!   Local:
     61!   ------
     62
    4863      REAL,SAVE :: vcont(ip1jm,llm),ucont(ip1jmp1,llm)
    49       REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
    50       REAL dv(ip1jm,llm),du(ip1jmp1,llm)
    51       REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
    52       REAL w(ip1jmp1,llm)
    53       REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
    54       REAL time
    55 
    56 c   Local:
    57 c   ------
    58 
    5964      REAL,SAVE :: ang(ip1jmp1,llm)
    6065      REAL,SAVE :: p(ip1jmp1,llmp1)
    … …  
    6873      INTEGER   ij,l,ijb,ije,ierr
    6974
    70 c-----------------------------------------------------------------------
    71 c   Calcul des tendances dynamiques:
    72 c   --------------------------------
     75!-----------------------------------------------------------------------
     76!   Compute dynamical tendencies:
     77!--------------------------------
     78
     79      ! compute contravariant winds ucont() and vcont
    7380      CALL covcont_p  ( llm    , ucov    , vcov , ucont, vcont        )
     81      ! compute pressure p()
    7482      CALL pression_p ( ip1jmp1, ap      , bp   ,  ps  , p            )
    75 cym      CALL psextbar (   ps   , psexbarxy                          )
    76 c$OMP BARRIER
     83!ym      CALL psextbar (   ps   , psexbarxy                          )
     84!$OMP BARRIER
     85      ! compute mass in each atmospheric mesh: masse()
    7786      CALL massdair_p (    p   , masse                                )
     87      ! compute X and Y-averages of mass, massebx() and masseby()
    7888      CALL massbar_p  (   masse, massebx , masseby                    )
     89      ! compute XY-average of mass, massebxy()
    7990      call massbarxy_p(   masse, massebxy                             )
     91      ! compute mass fluxes pbaru() and pbarv()
    8092      CALL flumass_p  ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
     93      ! compute dteta() , horizontal converging flux of theta
    8194      CALL dteta1_p   (   teta , pbaru   , pbarv, dteta               )
     95      ! compute convm(), horizontal converging flux of mass
    8296      CALL convmas1_p  (   pbaru, pbarv   , convm                      )
    83 c$OMP BARRIER     
     97!$OMP BARRIER     
    8498      CALL convmas2_p  (   convm                      )
    85 c$OMP BARRIER
     99!$OMP BARRIER
    86100#ifdef DEBUG_IO
    87 c$OMP BARRIER
    88 c$OMP MASTER
     101!$OMP BARRIER
     102!$OMP MASTER
    89103      call WriteField_p('ucont',reshape(ucont,(/iip1,jmp1,llm/)))
    90104      call WriteField_p('vcont',reshape(vcont,(/iip1,jjm,llm/)))
    … …  
    98112      call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/)))
    99113      call WriteField_p('convm',reshape(convm,(/iip1,jmp1,llm/)))
    100 c$OMP END MASTER
    101 c$OMP BARRIER
     114!$OMP END MASTER
     115!$OMP BARRIER
    102116#endif     
    103117
    104 c$OMP BARRIER
    105 c$OMP MASTER
     118!$OMP BARRIER
     119!$OMP MASTER
    106120      ijb=ij_begin
    107121      ije=ij_end
    108            
     122      ! compute pressure variation due to mass convergence
    109123      DO ij =ijb, ije
    110124         dp( ij ) = convm( ij,1 ) / airesurg( ij )
    111125      ENDDO
    112 c$OMP END MASTER
    113 c$OMP BARRIER
    114 c$OMP FLUSH
     126!$OMP END MASTER
     127!$OMP BARRIER
     128!$OMP FLUSH
     129     
     130      ! compute vertical velocity w()
    115131      CALL vitvert_p ( convm  , w                                  )
     132      ! compute potential vorticity vorpot()
    116133      CALL tourpot_p ( vcov   , ucov  , massebxy  , vorpot         )
     134      ! compute rotation induced du() and dv()
    117135      CALL dudv1_p   ( vorpot , pbaru , pbarv     , du     , dv    )
    118136
    119137#ifdef DEBUG_IO     
    120 c$OMP BARRIER
    121 c$OMP MASTER
     138!$OMP BARRIER
     139!$OMP MASTER
    122140      call WriteField_p('w',reshape(w,(/iip1,jmp1,llm/)))
    123141      call WriteField_p('vorpot',reshape(vorpot,(/iip1,jjm,llm/)))
    124142      call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
    125143      call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
    126 c$OMP END MASTER
    127 c$OMP BARRIER
     144!$OMP END MASTER
     145!$OMP BARRIER
    128146#endif     
     147     
     148      ! compute kinetic energy ecin()
    129149      CALL enercin_p ( vcov   , ucov  , vcont     , ucont  , ecin  )
     150      ! compute Bernouilli function bern()
    130151      CALL bernoui_p ( ip1jmp1, llm   , phi       , ecin   , bern  )
     152      ! compute and add du() and dv() contributions from Bernouilli and pressure
    131153      CALL dudv2_p   ( teta   , pkf   , bern      , du     , dv    )
    132154
    133155#ifdef DEBUG_IO
    134 c$OMP BARRIER
    135 c$OMP MASTER
     156!$OMP BARRIER
     157!$OMP MASTER
    136158      call WriteField_p('ecin',reshape(ecin,(/iip1,jmp1,llm/)))
    137159      call WriteField_p('bern',reshape(bern,(/iip1,jmp1,llm/)))
    … …  
    139161      call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
    140162      call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/)))
    141 c$OMP END MASTER
    142 c$OMP BARRIER
     163!$OMP END MASTER
     164!$OMP BARRIER
    143165#endif
    144166     
    … …  
    149171      if (pole_sud) ije=ij_end
    150172
    151 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
     173!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    152174      DO l=1,llm
    153175         DO ij=ijb,ije
    … …  
    155177        ENDDO
    156178      ENDDO
    157 c$OMP END DO
    158 
     179!$OMP END DO
     180
     181      ! compute vertical advection contributions to du(), dv() and dteta()
    159182      CALL advect_new_p(ang,vcov,teta,w,massebx,masseby,du,dv,dteta)
    160183
    161 C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
    162 C          probablement. Observe sur le code compile avec pgf90 3.0-1
     184!  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
     185!          probablement. Observe sur le code compile avec pgf90 3.0-1
    163186      ijb=ij_begin
    164187      ije=ij_end
    165188      if (pole_sud) ije=ij_end-iip1
    166189
    167 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     190!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    168191      DO l = 1, llm
    169192         DO ij = ijb, ije, iip1
    170193           IF( dv(ij,l).NE.dv(ij+iim,l) )  THEN
    171 c         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', 
    172 c    ,   ' dans caldyn'
    173 c         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
     194!         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', 
     195!    ,   ' dans caldyn'
     196!         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
    174197          dv(ij+iim,l) = dv(ij,l)
    175198          endif
    176199         enddo
    177200      enddo
    178 c$OMP END DO NOWAIT     
    179 c-----------------------------------------------------------------------
    180 c   Sorties eventuelles des variables de controle:
    181 c   ----------------------------------------------
     201!$OMP END DO NOWAIT     
     202!-----------------------------------------------------------------------
     203!   Output some control variables:
     204!---------------------------------
    182205
    183206      IF( conser )  THEN
    184 c ym ---> exige communication collective ( aussi dans advect)
     207! ym ---> exige communication collective ( aussi dans advect)
    185208        CALL sortvarc
    186      $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
     209     & ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
    187210
    188211      ENDIF
    189212
    190       RETURN
    191213      END

  • LMDZ5/branches/testing/libf/dyn3dpar/calfis_p.F

    r1910 r1999  
    3838      Use Write_field_p
    3939      USE Times
    40       USE infotrac
    41       USE control_mod
     40      USE infotrac, ONLY: nqtot, niadv, tname
     41      USE control_mod, ONLY: planet_type, nsplit_phys
    4242
    4343      IMPLICIT NONE
    … …  
    112112c    Arguments :
    113113c    -----------
    114       LOGICAL  lafin
    115 !      REAL heure
    116       REAL, intent(in):: jD_cur, jH_cur
    117       REAL pvcov(iip1,jjm,llm)
    118       REAL pucov(iip1,jjp1,llm)
    119       REAL pteta(iip1,jjp1,llm)
    120       REAL pmasse(iip1,jjp1,llm)
    121       REAL pq(iip1,jjp1,llm,nqtot)
    122       REAL pphis(iip1,jjp1)
    123       REAL pphi(iip1,jjp1,llm)
    124 c
    125       REAL pdvcov(iip1,jjm,llm)
    126       REAL pducov(iip1,jjp1,llm)
    127       REAL pdteta(iip1,jjp1,llm)
    128       REAL pdq(iip1,jjp1,llm,nqtot)
    129       REAL flxw(iip1,jjp1,llm)  ! Flux de masse verticale sur la grille dynamique
    130 c
    131       REAL pps(iip1,jjp1)
    132       REAL pp(iip1,jjp1,llmp1)
    133       REAL ppk(iip1,jjp1,llm)
    134 c
    135       REAL pdvfi(iip1,jjm,llm)
    136       REAL pdufi(iip1,jjp1,llm)
    137       REAL pdhfi(iip1,jjp1,llm)
    138       REAL pdqfi(iip1,jjp1,llm,nqtot)
    139       REAL pdpsfi(iip1,jjp1)
    140 
    141       INTEGER        longcles
    142       PARAMETER    ( longcles = 20 )
    143       REAL clesphy0( longcles )
     114      LOGICAL,INTENT(IN) ::  lafin ! .true. for the very last call to physics
     115      REAL,INTENT(IN) :: jD_cur, jH_cur
     116      REAL,INTENT(IN) :: pvcov(iip1,jjm,llm) ! covariant meridional velocity
     117      REAL,INTENT(IN) :: pucov(iip1,jjp1,llm) ! covariant zonal velocity
     118      REAL,INTENT(IN) :: pteta(iip1,jjp1,llm) ! potential temperature
     119      REAL,INTENT(IN) :: pmasse(iip1,jjp1,llm) ! mass in each cell ! not used
     120      REAL,INTENT(IN) :: pq(iip1,jjp1,llm,nqtot) ! tracers
     121      REAL,INTENT(IN) :: pphis(iip1,jjp1) ! surface geopotential
     122      REAL,INTENT(IN) :: pphi(iip1,jjp1,llm) ! geopotential
     123
     124      REAL,INTENT(IN) :: pdvcov(iip1,jjm,llm) ! dynamical tendency on vcov ! not used
     125      REAL,INTENT(IN) :: pducov(iip1,jjp1,llm) ! dynamical tendency on ucov
     126      REAL,INTENT(IN) :: pdteta(iip1,jjp1,llm) ! dynamical tendency on teta
     127      ! NB: pdteta is used only to compute pcvgt which is in fact not used...
     128      REAL,INTENT(IN) :: pdq(iip1,jjp1,llm,nqtot) ! dynamical tendency on tracers
     129      ! NB: pdq is only used to compute pcvgq which is in fact not used...
     130
     131      REAL,INTENT(IN) :: pps(iip1,jjp1) ! surface pressure (Pa)
     132      REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa)
     133      REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer
     134      REAL,INTENT(IN) :: flxw(iip1,jjp1,llm)  ! Vertical mass flux on dynamics grid
     135
     136      ! tendencies (in */s) from the physics
     137      REAL,INTENT(OUT) :: pdvfi(iip1,jjm,llm) ! tendency on covariant meridional wind
     138      REAL,INTENT(OUT) :: pdufi(iip1,jjp1,llm) ! tendency on covariant zonal wind
     139      REAL,INTENT(OUT) :: pdhfi(iip1,jjp1,llm) ! tendency on potential temperature (K/s)
     140      REAL,INTENT(OUT) :: pdqfi(iip1,jjp1,llm,nqtot) ! tendency on tracers
     141      REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s)
     142
     143      INTEGER,PARAMETER :: longcles = 20
     144      REAL,INTENT(IN) :: clesphy0( longcles ) ! unused
    144145
    145146#ifdef CPP_PHYS
    … …  
    217218c
    218219cIM diagnostique PVteta, Amip2
    219       INTEGER ntetaSTD
    220       PARAMETER(ntetaSTD=3)
    221       REAL rtetaSTD(ntetaSTD)
    222       DATA rtetaSTD/350., 380., 405./ ! Earth-specific values, beware !!
     220      INTEGER,PARAMETER :: ntetaSTD=3
     221      REAL,SAVE :: rtetaSTD(ntetaSTD)=(/350.,380.,405./) ! Earth-specific, beware !!
    223222      REAL PVteta(klon,ntetaSTD)
    224223     
    225      
    226224      REAL SSUM
    227225
    228       LOGICAL firstcal, debut
    229       DATA firstcal/.true./
    230       SAVE firstcal,debut
     226      LOGICAL,SAVE :: firstcal=.true., debut=.true.
    231227c$OMP THREADPRIVATE(firstcal,debut)
    232228     

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

    r1910 r1999  
    115115  END IF
    116116
    117   IF (grilles_gcm_netcdf) THEN
    118      WRITE(lunout,'(//)')
    119      WRITE(lunout,*) '  ***************************  '
    120      WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
    121      WRITE(lunout,*) '  ***************************  '
    122      WRITE(lunout,'(//)')
    123      CALL grilles_gcm_netcdf_sub(masque,phis)
    124   END IF
     117  WRITE(lunout,'(//)')
     118  WRITE(lunout,*) '  ***************************  '
     119  WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
     120  WRITE(lunout,*) '  ***************************  '
     121  WRITE(lunout,'(//)')
     122  CALL grilles_gcm_netcdf_sub(masque,phis)
    125123 
    126124#ifdef CPP_MPI

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

    r1910 r1999  
    942942      ok_etat0 = .TRUE.
    943943      CALL getin('ok_etat0',ok_etat0)
    944 
    945 !Config  Key  = grilles_gcm_netcdf
    946 !Config  Desc = creation de fichier grilles_gcm.nc dans create_etat0_limit
    947 !Config  Def  = n
    948       grilles_gcm_netcdf = .FALSE.
    949       CALL getin('grilles_gcm_netcdf',grilles_gcm_netcdf)
    950944
    951945      write(lunout,*)' #########################################'
    … …  
    997991      write(lunout,*)' ok_limit = ', ok_limit
    998992      write(lunout,*)' ok_etat0 = ', ok_etat0
    999       write(lunout,*)' grilles_gcm_netcdf = ', grilles_gcm_netcdf
    1000993c
    1001994      RETURN

  • LMDZ5/branches/testing/libf/dyn3dpar/dissip_p.F

    r1910 r1999  
     1!
     2! $Id$
     3!
    14      SUBROUTINE dissip_p( vcov,ucov,teta,p, dv,du,dh )
    25c
    … …  
    3437c   ----------
    3538
    36       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    37       REAL  p( ip1jmp1,llmp1 )
    38       REAL dv(ip1jm,llm),du(ip1jmp1,llm),dh(ip1jmp1,llm)
     39      REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind
     40      REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind
     41      REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potentail temperature
     42      REAL,INTENT(IN) :: p(ip1jmp1,llmp1) ! pressure
     43      ! tendencies (.../s) on covariant winds and potential temperature
     44      REAL,INTENT(OUT) :: dv(ip1jm,llm)
     45      REAL,INTENT(OUT) :: du(ip1jmp1,llm)
     46      REAL,INTENT(OUT) :: dh(ip1jmp1,llm)
    3947
    4048c   Local:

  • LMDZ5/branches/testing/libf/dyn3dpar/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/dyn3dpar/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/dyn3dpar/fxhyp.F

    r1910 r1999  
    6969c
    7070       if (iim==1) then
    71 
    72           print*,'Longitudes calculees a la main pour iim=1'
    7371
    7472          rlonm025(1)=-pi/2.
    … …  
    180178        WRITE(6,*)'Modifier les valeurs de  grossismx ,tau ou dzoomx ',
    181179     , ' et relancer ! ***  '
    182         CALL ABORT
     180        CALL ABORT_GCM("FXHYP", "", 1)
    183181       ENDIF
    184182c
    … …  
    307305
    3083061500   CONTINUE
    309 
    310307
    311308

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

    r1910 r1999  
    332332          start_time = starttime
    333333        ELSE
    334           WRITE(lunout,*)'Je m''arrete'
    335           CALL abort
     334          call abort_gcm("gcm", "'Je m''arrete'", 1)
    336335        ENDIF
    337336      ENDIF

  • LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F

    r1910 r1999  
    1717       USE vampir
    1818       USE timer_filtre, ONLY : print_filtre_timer
    19        USE infotrac
     19       USE infotrac, ONLY: nqtot
    2020       USE guide_p_mod, ONLY : guide_main
    2121       USE getparam
    22        USE control_mod
    23 
     22       USE control_mod, ONLY: nday, day_step, planet_type, offline,
     23     &                       iconser, iphysiq, iperiod, dissip_period,
     24     &                       iecri, ip_ebil_dyn, ok_dynzon, ok_dyn_ins,
     25     &                       periodav, ok_dyn_ave, output_grads_dyn,
     26     &                       iapp_tracvl
    2427      IMPLICIT NONE
    2528
    … …  
    7073#include "academic.h"
    7174     
    72       INTEGER         longcles
    73       PARAMETER     ( longcles = 20 )
    74       REAL  clesphy0( longcles )
     75      INTEGER,PARAMETER :: longcles = 20
     76      REAL,INTENT(IN) :: clesphy0( longcles ) ! not used
     77      REAL,INTENT(IN) :: time_0 ! not used
     78
     79c   dynamical variables:
     80      REAL,INTENT(INOUT) :: ucov(ip1jmp1,llm)    ! zonal covariant wind
     81      REAL,INTENT(INOUT) :: vcov(ip1jm,llm)      ! meridional covariant wind
     82      REAL,INTENT(INOUT) :: teta(ip1jmp1,llm)    ! potential temperature
     83      REAL,INTENT(INOUT) :: ps(ip1jmp1)          ! surface pressure (Pa)
     84      REAL,INTENT(INOUT) :: masse(ip1jmp1,llm)   ! air mass
     85      REAL,INTENT(INOUT) :: phis(ip1jmp1)        ! geopotentiat at the surface
     86      REAL,INTENT(INOUT) :: q(ip1jmp1,llm,nqtot) ! advected tracers
     87
     88      REAL,SAVE :: p (ip1jmp1,llmp1  )       ! interlayer pressure
     89      REAL,SAVE :: pks(ip1jmp1)              ! exner at the surface
     90      REAL,SAVE :: pk(ip1jmp1,llm)           ! exner at mid-layer
     91      REAL,SAVE :: pkf(ip1jmp1,llm)          ! filtered exner at mid-layer
     92      REAL,SAVE :: phi(ip1jmp1,llm)          ! geopotential
     93      REAL,SAVE :: w(ip1jmp1,llm)            ! vertical velocity
    7594
    7695      real zqmin,zqmax
    77 
    78 c   variables dynamiques
    79       REAL :: vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    80       REAL :: teta(ip1jmp1,llm)                 ! temperature potentielle
    81       REAL :: q(ip1jmp1,llm,nqtot)              ! champs advectes
    82       REAL :: ps(ip1jmp1)                       ! pression  au sol
    83       REAL,SAVE :: p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    84       REAL,SAVE :: pks(ip1jmp1)                      ! exner au  sol
    85       REAL,SAVE :: pk(ip1jmp1,llm)                   ! exner au milieu des couches
    86       REAL,SAVE :: pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
    87       REAL :: masse(ip1jmp1,llm)                ! masse d'air
    88       REAL :: phis(ip1jmp1)                     ! geopotentiel au sol
    89       REAL,SAVE :: phi(ip1jmp1,llm)                  ! geopotentiel
    90       REAL,SAVE :: w(ip1jmp1,llm)                    ! vitesse verticale
    9196
    9297c variables dynamiques intermediaire pour le transport
    … …  
    123128
    124129      REAL  SSUM
    125       REAL time_0
    126130!      REAL,SAVE :: finvmaold(ip1jmp1,llm)
    127131
    … …  
    603607
    604608      IF( forward. OR . leapf )  THEN
    605 cc$OMP PARALLEL DEFAULT(SHARED)
    606 c
     609! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step
    607610         CALL caladvtrac_p(q,pbaru,pbarv,
    608611     *        p, masse, dq,  teta,
    … …  
    616619
    617620      ENDIF ! of IF( forward. OR . leapf )
    618 cc$OMP END PARALLEL
    619621
    620622c-----------------------------------------------------------------------
    … …  
    763765        call Register_SwapFieldHallo(masse,masse,ip1jmp1,llm,
    764766     *                               jj_Nb_physic,1,2,Request_physic)
     767
     768        call Register_SwapFieldHallo(ps,ps,ip1jmp1,1,
     769     *                               jj_Nb_physic,2,2,Request_physic)
    765770
    766771        call Register_SwapFieldHallo(p,p,ip1jmp1,llmp1,
    … …  
    907912     $                  ucov, vcov, teta , q   ,ps ,
    908913     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
    909 
     914          ! since addfi updates ps(), also update p(), masse() and pk()
     915          CALL pression_p(ip1jmp1,ap,bp,ps,p)
     916c$OMP BARRIER
     917          CALL massdair_p(p,masse)
     918c$OMP BARRIER
     919          if (pressure_exner) then
     920            CALL exner_hyb_p(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
     921          else
     922            CALL exner_milieu_p(ip1jmp1,ps,p,beta,pks,pk,pkf)
     923          endif
     924c$OMP BARRIER
     925         
    910926         IF (ok_strato) THEN
    911927           CALL top_bound_p(vcov,ucov,teta,masse,dtphys)
    … …  
    930946       
    931947        call Register_SwapField(masse,masse,ip1jmp1,llm,
     948     *                               jj_Nb_caldyn,Request_physic)
     949
     950        call Register_SwapField(ps,ps,ip1jmp1,1,
    932951     *                               jj_Nb_caldyn,Request_physic)
    933952
    … …  
    10441063          CALL exner_milieu_p( ip1jmp1, ps, p, beta, pks, pk, pkf )
    10451064        endif
     1065c$OMP BARRIER
     1066        CALL massdair_p(p,masse)
    10461067c$OMP BARRIER
    10471068

  • LMDZ5/branches/testing/libf/dyn3dpar/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)

  • LMDZ5/branches/testing/libf/dyn3dpar/mod_const_mpi.F90

    r1910 r1999  
    1717    USE ioipsl_getincom, only: getin
    1818#endif
    19 
     19! Use of Oasis-MCT coupler
     20#ifdef CPP_OMCT
     21    USE mod_prism
     22#endif
    2023    IMPLICIT NONE
    2124#ifdef CPP_MPI

  • LMDZ5/branches/testing/libf/dyn3dpar/parallel_lmdz.F90

    r1910 r1999  
    225225#endif
    226226#ifdef CPP_COUPLE
     227! Use of Oasis-MCT coupler
     228#if defined CPP_OMCT
     229    use mod_prism
     230#else
    227231    use mod_prism_proto
     232#endif
    228233! Ehouarn: surface_data module is in 'phylmd' ...
    229234      use surface_data, only : type_ocean
Note: See TracChangeset for help on using the changeset viewer.