source: LMDZ6/trunk/libf/dyn3d_common/iniconst.f90 @ 5348

Last change on this file since 5348 was 5285, checked in by abarral, 5 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.0 KB
Line 
1!
2! $Id: iniconst.f90 5285 2024-10-28 13:33:29Z fhourdin $
3!
4SUBROUTINE iniconst
5
6  USE iniprint_mod_h
7  USE control_mod
8  use IOIPSL
9
10  USE comconst_mod, ONLY: im, imp1, jm, jmp1, lllm, lllmm1, lllmp1, &
11                          unsim, pi, r, kappa, cpp, dtvr, dtphys
12  USE comvert_mod, ONLY: disvert_type, pressure_exner
13
14  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
15USE paramet_mod_h
16IMPLICIT NONE
17  !
18  !      P. Le Van
19  !
20  !   Declarations:
21  !   -------------
22  !
23
24
25
26  character(len=*),parameter :: modname="iniconst"
27  character(len=80) :: abort_message
28  !
29  !
30  !
31  !-----------------------------------------------------------------------
32  !   dimension des boucles:
33  !   ----------------------
34
35  im      = iim
36  jm      = jjm
37  lllm    = llm
38  imp1    = iim
39  jmp1    = jjm + 1
40  lllmm1  = llm - 1
41  lllmp1  = llm + 1
42
43  !-----------------------------------------------------------------------
44
45  dtphys  = iphysiq * dtvr
46  unsim   = 1./iim
47  pi      = 2.*ASIN( 1. )
48
49  !-----------------------------------------------------------------------
50  !
51
52  r       = cpp * kappa
53
54  write(lunout,*) trim(modname),': R  CP  Kappa ',r,cpp,kappa
55  !
56  !-----------------------------------------------------------------------
57
58  ! vertical discretization: default behavior depends on planet_type flag
59  if (planet_type=="earth") then
60     disvert_type=1
61  else
62     disvert_type=2
63  endif
64  ! but user can also specify using one or the other in run.def:
65  call getin('disvert_type',disvert_type)
66  write(lunout,*) trim(modname),': disvert_type=',disvert_type
67
68  pressure_exner = disvert_type == 1 ! default value
69  call getin('pressure_exner', pressure_exner)
70
71  if (disvert_type==1) then
72     ! standard case for Earth (automatic generation of levels)
73     call disvert()
74  else if (disvert_type==2) then
75     ! standard case for planets (levels generated using z2sig.def file)
76     call disvert_noterre
77  else
78     write(abort_message,*) "Wrong value for disvert_type: ", disvert_type
79     call abort_gcm(modname,abort_message,0)
80  endif
81
82END SUBROUTINE iniconst
Note: See TracBrowser for help on using the repository browser.