Ignore:
Timestamp:
Jul 22, 2016, 8:44:47 AM (8 years ago)
Author:
Ehouarn Millour
Message:

Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod.
EM

Location:
LMDZ5/trunk/libf/dyn3d
Files:
23 edited

Legend:

Unmodified
Added
Removed
  • LMDZ5/trunk/libf/dyn3d/addfi.F

    r1987 r2597  
    4646c    ------------------
    4747c
    48 #include "dimensions.h"
    49 #include "paramet.h"
    50 #include "comconst.h"
    51 #include "comgeom.h"
    52 #include "serre.h"
     48      include "dimensions.h"
     49      include "paramet.h"
     50      include "comgeom.h"
     51      include "serre.h"
    5352c
    5453c    Arguments :
  • LMDZ5/trunk/libf/dyn3d/advect.F

    r1907 r2597  
    44      SUBROUTINE advect(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta)
    55
     6      USE comconst_mod, ONLY: daysec
     7     
    68      IMPLICIT NONE
    79c=======================================================================
     
    2426c   -------------
    2527
    26 #include "dimensions.h"
    27 #include "paramet.h"
    28 #include "comconst.h"
    29 #include "comvert.h"
    30 #include "comgeom.h"
    31 #include "logic.h"
    32 #include "ener.h"
     28      include "dimensions.h"
     29      include "paramet.h"
     30      include "comvert.h"
     31      include "comgeom.h"
     32      include "logic.h"
     33      include "ener.h"
    3334
    3435c   Arguments:
  • LMDZ5/trunk/libf/dyn3d/advtrac.F90

    r2286 r2597  
    1111  USE infotrac, ONLY: nqtot, iadv,nqperes,ok_iso_verif
    1212  USE control_mod, ONLY: iapp_tracvl, day_step
    13 
     13  USE comconst_mod, ONLY: dtvr
    1414
    1515  IMPLICIT NONE
     
    1717  include "dimensions.h"
    1818  include "paramet.h"
    19   include "comconst.h"
    2019  include "comvert.h"
    2120  include "comdissip.h"
  • LMDZ5/trunk/libf/dyn3d/bilan_dyn.F

    r1907 r2597  
    1313      USE IOIPSL
    1414#endif
     15      USE comconst_mod, ONLY: pi, cpp
    1516
    1617      IMPLICIT NONE
    1718
    18 #include "dimensions.h"
    19 #include "paramet.h"
    20 #include "comconst.h"
    21 #include "comvert.h"
    22 #include "comgeom2.h"
    23 #include "temps.h"
    24 #include "iniprint.h"
     19      include "dimensions.h"
     20      include "paramet.h"
     21      include "comvert.h"
     22      include "comgeom2.h"
     23      include "temps.h"
     24      include "iniprint.h"
    2525
    2626c====================================================================
  • LMDZ5/trunk/libf/dyn3d/caladvtrac.F

    r2286 r2597  
    1010      USE infotrac, ONLY : nqtot
    1111      USE control_mod, ONLY : iapp_tracvl,planet_type
     12      USE comconst_mod, ONLY: dtvr
    1213 
    1314      IMPLICIT NONE
     
    2324
    2425
    25 #include "dimensions.h"
    26 #include "paramet.h"
    27 #include "comconst.h"
     26      include "dimensions.h"
     27      include "paramet.h"
    2828
    2929c   Arguments:
  • LMDZ5/trunk/libf/dyn3d/caldyn.F

    r1987 r2597  
    2424!   ----------------
    2525
    26 #include "dimensions.h"
    27 #include "paramet.h"
    28 #include "comconst.h"
    29 #include "comvert.h"
    30 #include "comgeom.h"
     26      include "dimensions.h"
     27      include "paramet.h"
     28      include "comvert.h"
     29      include "comgeom.h"
    3130
    3231!   Arguments:
  • LMDZ5/trunk/libf/dyn3d/conf_gcm.F90

    r2442 r2597  
    1313  USE infotrac, ONLY : type_trac
    1414  use assert_m, only: assert
     15  USE comconst_mod, ONLY: dissip_deltaz, dissip_factz, dissip_zref, &
     16                          iflag_top_bound, mode_top_bound, tau_top_bound, &
     17                          ngroup
    1518
    1619  IMPLICIT NONE
     
    3538  include "comdissnew.h"
    3639  include "temps.h"
    37   include "comconst.h"
    3840  include "iniprint.h"
    3941
  • LMDZ5/trunk/libf/dyn3d/dissip.F

    r1987 r2597  
    44      SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
    55c
     6      USE comconst_mod, ONLY: dtdiss
     7     
    68      IMPLICIT NONE
    79
     
    2527c   -------------
    2628
    27 #include "dimensions.h"
    28 #include "paramet.h"
    29 #include "comconst.h"
    30 #include "comgeom.h"
    31 #include "comdissnew.h"
    32 #include "comdissipn.h"
     29      include "dimensions.h"
     30      include "paramet.h"
     31      include "comgeom.h"
     32      include "comdissnew.h"
     33      include "comdissipn.h"
    3334
    3435c   Arguments:
  • LMDZ5/trunk/libf/dyn3d/dynetat0.f90

    r2299 r2597  
    1111  USE control_mod, ONLY: planet_type
    1212  USE assert_eq_m, ONLY: assert_eq
     13  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad
    1314  IMPLICIT NONE
    1415  include "dimensions.h"
    1516  include "paramet.h"
    1617  include "temps.h"
    17   include "comconst.h"
    1818  include "comvert.h"
    1919  include "comgeom2.h"
  • LMDZ5/trunk/libf/dyn3d/dynredem.F90

    r2299 r2597  
    1111                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER
    1212  USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, err, modname, fil
     13  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, kappa, omeg, rad
    1314  IMPLICIT NONE
    1415  include "dimensions.h"
    1516  include "paramet.h"
    16   include "comconst.h"
    1717  include "comvert.h"
    1818  include "comgeom2.h"
  • LMDZ5/trunk/libf/dyn3d/fluxstokenc.F

    r2239 r2597  
    1616      IMPLICIT NONE
    1717c
    18 #include "dimensions.h"
    19 #include "paramet.h"
    20 #include "comconst.h"
    21 #include "comvert.h"
    22 #include "comgeom.h"
    23 #include "tracstoke.h"
    24 #include "temps.h"
    25 #include "iniprint.h"
     18      include "dimensions.h"
     19      include "paramet.h"
     20      include "comvert.h"
     21      include "comgeom.h"
     22      include "tracstoke.h"
     23      include "temps.h"
     24      include "iniprint.h"
    2625
    2726      REAL time_step,t_wrt, t_ops
  • LMDZ5/trunk/libf/dyn3d/friction.F

    r1907 r2597  
    1212      USE ioipsl_getincom
    1313#endif
    14      
     14      USE comconst_mod, ONLY: pi
    1515      IMPLICIT NONE
    1616
     
    2727!=======================================================================
    2828
    29 #include "dimensions.h"
    30 #include "paramet.h"
    31 #include "comgeom2.h"
    32 #include "comconst.h"
    33 #include "iniprint.h"
    34 #include "academic.h"
     29      include "dimensions.h"
     30      include "paramet.h"
     31      include "comgeom2.h"
     32      include "iniprint.h"
     33      include "academic.h"
    3534
    3635! arguments:
  • LMDZ5/trunk/libf/dyn3d/gcm.F90

    r2438 r2597  
    2323  USE control_mod
    2424  USE mod_const_mpi, ONLY: COMM_LMDZ
    25 
     25  USE comconst_mod, ONLY: cpp, daysec, dtphys, dtvr, g, r, rad
    2626
    2727!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     
    6868  include "dimensions.h"
    6969  include "paramet.h"
    70   include "comconst.h"
    7170  include "comdissnew.h"
    7271  include "comvert.h"
     
    7473  include "logic.h"
    7574  include "temps.h"
    76 !!!!!!!!!!!include "control.h"
    7775  include "ener.h"
    7876  include "description.h"
     
    8987  REAL, ALLOCATABLE, DIMENSION(:,:,:):: q! champs advectes
    9088  REAL ps(ip1jmp1)                       ! pression  au sol
    91   REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
     89!  REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    9290  REAL masse(ip1jmp1,llm)                ! masse d'air
    9391  REAL phis(ip1jmp1)                     ! geopotentiel au sol
    94   REAL phi(ip1jmp1,llm)                  ! geopotentiel
    95   REAL w(ip1jmp1,llm)                    ! vitesse verticale
     92!  REAL phi(ip1jmp1,llm)                  ! geopotentiel
     93!  REAL w(ip1jmp1,llm)                    ! vitesse verticale
    9694
    9795  ! variables dynamiques intermediaire pour le transport
     
    103101
    104102  LOGICAL lafin
    105   INTEGER ij,iq,l,i,j
    106103
    107104
    108105  real time_step, t_wrt, t_ops
    109 
    110   LOGICAL first
    111106
    112107  !      LOGICAL call_iniphys
     
    118113  !     tansformation d'energie cinetique en energie thermique
    119114  !     cree par la dissipation
    120   REAL dhecdt(ip1jmp1,llm)
     115!  REAL dhecdt(ip1jmp1,llm)
    121116  !      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
    122117  !      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_ec
    123   CHARACTER (len=15) :: ztit
     118!  CHARACTER (len=15) :: ztit
    124119  !-jld
    125120
  • LMDZ5/trunk/libf/dyn3d/groupe.F

    r2442 r2597  
    33!
    44      subroutine groupe(pext,pbaru,pbarv,pbarum,pbarvm,wm)
     5     
     6      use comconst_mod, only: ngroup
     7     
    58      implicit none
    69
     
    1619c   pas besoin de w en entree.
    1720
    18 #include "dimensions.h"
    19 #include "paramet.h"
    20 #include "comconst.h"
    21 #include "comgeom2.h"
    22 #include "comvert.h"
     21      include "dimensions.h"
     22      include "paramet.h"
     23      include "comgeom2.h"
     24      include "comvert.h"
    2325
    2426!     integer ngroup
  • LMDZ5/trunk/libf/dyn3d/groupeun.F

    r2442 r2597  
    33!
    44      SUBROUTINE groupeun(jjmax,llmax,q)
     5     
     6      USE comconst_mod, ONLY: ngroup
     7     
    58      IMPLICIT NONE
    69
    7 #include "dimensions.h"
    8 #include "paramet.h"
    9 #include "comconst.h"
    10 #include "comgeom2.h"
     10      include "dimensions.h"
     11      include "paramet.h"
     12      include "comgeom2.h"
    1113
    1214      INTEGER jjmax,llmax
     
    135137     
    136138      SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab)
     139     
     140      USE comconst_mod, ONLY: ngroup
     141     
    137142      IMPLICIT NONE
    138143
    139 #include "dimensions.h"
    140 #include "paramet.h"
    141 #include "comconst.h"
    142 #include "comgeom2.h"
     144      include "dimensions.h"
     145      include "paramet.h"
     146      include "comgeom2.h"
    143147
    144148!     INTEGER ngroup
  • LMDZ5/trunk/libf/dyn3d/guide_mod.F90

    r2263 r2597  
    314314  SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
    315315
    316     USE control_mod
     316    USE control_mod, ONLY: day_step, iperiod
     317    USE comconst_mod, ONLY: dtvr, daysec
    317318 
    318319    IMPLICIT NONE
     
    320321    INCLUDE "dimensions.h"
    321322    INCLUDE "paramet.h"
    322     INCLUDE "comconst.h"
    323323    INCLUDE "comvert.h"
    324324
     
    542542  SUBROUTINE guide_zonave(typ,hsize,vsize,field)
    543543
     544    USE comconst_mod, ONLY: pi
     545   
    544546    IMPLICIT NONE
    545547
     
    547549    INCLUDE "paramet.h"
    548550    INCLUDE "comgeom.h"
    549     INCLUDE "comconst.h"
    550551   
    551552    ! input/output variables
     
    607608  use exner_hyb_m, only: exner_hyb
    608609  use exner_milieu_m, only: exner_milieu
     610  use comconst_mod, only: kappa, cpp
    609611  IMPLICIT NONE
    610612
     
    613615  include "comvert.h"
    614616  include "comgeom2.h"
    615   include "comconst.h"
    616617
    617618  REAL, DIMENSION (iip1,jjp1),     INTENT(IN) :: psi ! Psol gcm
     
    777778            do j=1,jjp1
    778779                IF (guide_teta) THEN
    779                     do i=1,iim
    780                         ij=(j-1)*iip1+i
    781                         tgui1(ij,l)=zu1(i,j,l)
    782                         tgui2(ij,l)=zu2(i,j,l)
    783                     enddo
     780                    do i=1,iim
     781                        ij=(j-1)*iip1+i
     782                        tgui1(ij,l)=zu1(i,j,l)
     783                        tgui2(ij,l)=zu2(i,j,l)
     784                    enddo
    784785                ELSE
    785                     do i=1,iim
    786                         ij=(j-1)*iip1+i
    787                         tgui1(ij,l)=zu1(i,j,l)*cpp/pk(i,j,l)
    788                         tgui2(ij,l)=zu2(i,j,l)*cpp/pk(i,j,l)
    789                     enddo
     786                    do i=1,iim
     787                        ij=(j-1)*iip1+i
     788                        tgui1(ij,l)=zu1(i,j,l)*cpp/pk(i,j,l)
     789                        tgui2(ij,l)=zu2(i,j,l)*cpp/pk(i,j,l)
     790                    enddo
    790791                ENDIF
    791792                tgui1(j*iip1,l)=tgui1((j-1)*iip1+1,l)   
     
    855856! Calcul des constantes de rappel alpha (=1/tau)
    856857
     858    use comconst_mod, only: pi
     859   
    857860    implicit none
    858861
    859862    include "dimensions.h"
    860863    include "paramet.h"
    861     include "comconst.h"
    862864    include "comgeom2.h"
    863865    include "serre.h"
     
    15161518  SUBROUTINE guide_out(varname,hsize,vsize,field)
    15171519
     1520    USE comconst_mod, ONLY: pi
     1521   
    15181522    IMPLICIT NONE
    15191523
     
    15221526    INCLUDE "netcdf.inc"
    15231527    INCLUDE "comgeom2.h"
    1524     INCLUDE "comconst.h"
    15251528    INCLUDE "comvert.h"
    15261529   
  • LMDZ5/trunk/libf/dyn3d/iniacademic.F90

    r2270 r2597  
    1616  use exner_hyb_m, only: exner_hyb
    1717  use exner_milieu_m, only: exner_milieu
     18  USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm
    1819
    1920  !   Author:    Frederic Hourdin      original: 15/01/93
     
    2930  include "paramet.h"
    3031  include "comvert.h"
    31   include "comconst.h"
    3232  include "comgeom.h"
    3333  include "academic.h"
  • LMDZ5/trunk/libf/dyn3d/integrd.F

    r2094 r2597  
    88
    99      use control_mod, only : planet_type
     10      use comconst_mod, only: pi
    1011
    1112      IMPLICIT NONE
     
    2728c   -------------
    2829
    29 #include "dimensions.h"
    30 #include "paramet.h"
    31 #include "comconst.h"
    32 #include "comgeom.h"
    33 #include "comvert.h"
    34 #include "logic.h"
    35 #include "temps.h"
    36 #include "serre.h"
    37 #include "iniprint.h"
     30      include "dimensions.h"
     31      include "paramet.h"
     32      include "comgeom.h"
     33      include "comvert.h"
     34      include "logic.h"
     35      include "temps.h"
     36      include "serre.h"
     37      include "iniprint.h"
    3838
    3939c   Arguments:
  • LMDZ5/trunk/libf/dyn3d/leapfrog.F

    r2475 r2597  
    2020      use exner_hyb_m, only: exner_hyb
    2121      use exner_milieu_m, only: exner_milieu
     22      USE comconst_mod, ONLY: cpp, dtphys, dtvr, pi, ihf
    2223
    2324      IMPLICIT NONE
     
    5455c   -------------
    5556
    56 #include "dimensions.h"
    57 #include "paramet.h"
    58 #include "comconst.h"
    59 #include "comdissnew.h"
    60 #include "comvert.h"
    61 #include "comgeom.h"
    62 #include "logic.h"
    63 #include "temps.h"
    64 #include "ener.h"
    65 #include "description.h"
    66 #include "serre.h"
    67 !#include "com_io_dyn.h"
    68 #include "iniprint.h"
    69 #include "academic.h"
     57      include "dimensions.h"
     58      include "paramet.h"
     59      include "comdissnew.h"
     60      include "comvert.h"
     61      include "comgeom.h"
     62      include "logic.h"
     63      include "temps.h"
     64      include "ener.h"
     65      include "description.h"
     66      include "serre.h"
     67      include "iniprint.h"
     68      include "academic.h"
    7069
    7170      REAL,INTENT(IN) :: time_0 ! not used
  • LMDZ5/trunk/libf/dyn3d/sw_case_williamson91_6.F

    r1907 r2597  
    2626c
    2727c=======================================================================
     28      USE comconst_mod, ONLY: cpp, omeg, rad
     29     
    2830      IMPLICIT NONE
    2931c-----------------------------------------------------------------------
     
    3133c   ---------------
    3234
    33 #include "dimensions.h"
    34 #include "paramet.h"
    35 #include "comvert.h"
    36 #include "comconst.h"
    37 #include "comgeom.h"
    38 #include "iniprint.h"
     35      include "dimensions.h"
     36      include "paramet.h"
     37      include "comvert.h"
     38      include "comgeom.h"
     39      include "iniprint.h"
    3940
    4041c   Arguments:
  • LMDZ5/trunk/libf/dyn3d/top_bound.F

    r1907 r2597  
    33!
    44      SUBROUTINE top_bound(vcov,ucov,teta,masse,dt)
     5     
     6      USE comconst_mod, ONLY: iflag_top_bound, mode_top_bound,
     7     &                        tau_top_bound
     8     
    59      IMPLICIT NONE
    610c
    7 #include "dimensions.h"
    8 #include "paramet.h"
    9 #include "comconst.h"
    10 #include "comvert.h"
    11 #include "comgeom2.h"
     11      include "dimensions.h"
     12      include "paramet.h"
     13      include "comvert.h"
     14      include "comgeom2.h"
    1215
    1316
     
    3942! NB: top_bound sponge is only called from leapfrog if ok_strato=.true.
    4043
    41 ! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst.h)
     44! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst_mod)
    4245!    iflag_top_bound=0 for no sponge
    4346!    iflag_top_bound=1 for sponge over 4 topmost layers
  • LMDZ5/trunk/libf/dyn3d/vlsplt.F

    r2286 r2597  
    2121      IMPLICIT NONE
    2222c
    23 #include "dimensions.h"
    24 #include "paramet.h"
    25 #include "logic.h"
    26 #include "comvert.h"
    27 #include "comconst.h"
     23      include "dimensions.h"
     24      include "paramet.h"
     25      include "logic.h"
     26      include "comvert.h"
    2827
    2928c
     
    159158      include "logic.h"
    160159      include "comvert.h"
    161       include "comconst.h"
    162160      include "iniprint.h"
    163161c
     
    528526c
    529527c   --------------------------------------------------------------------
     528      USE comconst_mod, ONLY: pi
    530529      IMPLICIT NONE
    531530c
    532 #include "dimensions.h"
    533 #include "paramet.h"
    534 #include "logic.h"
    535 #include "comvert.h"
    536 #include "comconst.h"
    537 #include "comgeom.h"
     531      include "dimensions.h"
     532      include "paramet.h"
     533      include "logic.h"
     534      include "comvert.h"
     535      include "comgeom.h"
    538536c
    539537c
     
    893891      IMPLICIT NONE
    894892c
    895 #include "dimensions.h"
    896 #include "paramet.h"
    897 #include "logic.h"
    898 #include "comvert.h"
    899 #include "comconst.h"
     893      include "dimensions.h"
     894      include "paramet.h"
     895      include "logic.h"
     896      include "comvert.h"
    900897c
    901898c
  • LMDZ5/trunk/libf/dyn3d/vlspltqs.F

    r2286 r2597  
    2323c     pk exner au milieu des couches necessaire pour calculer Qsat
    2424c   --------------------------------------------------------------------
     25     
     26      USE comconst_mod, ONLY: cpp
     27     
    2528      IMPLICIT NONE
    2629c
    27 #include "dimensions.h"
    28 #include "paramet.h"
    29 #include "logic.h"
    30 #include "comvert.h"
    31 #include "comconst.h"
     30      include "dimensions.h"
     31      include "paramet.h"
     32      include "logic.h"
     33      include "comvert.h"
    3234
    3335c
     
    192194      IMPLICIT NONE
    193195c
    194 #include "dimensions.h"
    195 #include "paramet.h"
    196 #include "logic.h"
    197 #include "comvert.h"
    198 #include "comconst.h"
     196      include "dimensions.h"
     197      include "paramet.h"
     198      include "logic.h"
     199      include "comvert.h"
    199200c
    200201c
     
    559560c
    560561c   --------------------------------------------------------------------
     562     
     563      USE comconst_mod, ONLY: pi
     564     
    561565      IMPLICIT NONE
    562566c
    563 #include "dimensions.h"
    564 #include "paramet.h"
    565 #include "logic.h"
    566 #include "comvert.h"
    567 #include "comconst.h"
    568 #include "comgeom.h"
     567      include "dimensions.h"
     568      include "paramet.h"
     569      include "logic.h"
     570      include "comvert.h"
     571      include "comgeom.h"
    569572c
    570573c
Note: See TracChangeset for help on using the changeset viewer.