source: LMDZ6/trunk/libf/phylmd/inifis_mod.f90 @ 5274

Last change on this file since 5274 was 5274, checked in by abarral, 9 hours ago

Replace yomcst.h by existing module

  • 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: 3.6 KB
Line 
1! $Id: inifis_mod.f90 5274 2024-10-25 13:41:23Z abarral $
2MODULE inifis_mod
3
4CONTAINS
5
6  SUBROUTINE inifis(punjours, prad, pg, pr, pcpp)
7  ! Initialize some physical constants and settings
8  USE init_print_control_mod, ONLY : init_print_control
9  USE print_control_mod, ONLY: lunout
10  USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
11          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
12          , R_ecc, R_peri, R_incl                                      &
13          , RA, RG, R1SA                                         &
14          , RSIGMA                                                     &
15          , R, RMD, RMV, RD, RV, RCPD                    &
16          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
17          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
18          , RCW, RCS                                                 &
19          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
20          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
21          , RALPD, RBETD, RGAMD
22IMPLICIT NONE
23
24
25  REAL,INTENT(IN) :: prad, pg, pr, pcpp, punjours
26
27  CHARACTER (LEN=20) :: modname = 'inifis'
28  CHARACTER (LEN=80) :: abort_message
29
30  ! Initialize flags lunout, prt_level, debug
31  CALL init_print_control
32
33  ! suphel => initialize some physical constants (orbital parameters,
34  !           geoid, gravity, thermodynamical constants, etc.) in the
35  !           physics
36  CALL suphel
37
38  ! check that physical constants set in 'suphel' are coherent
39  ! with values set in the dynamics:
40  IF (rday/=punjours) THEN
41    WRITE (lunout, *) 'inifis: length of day discrepancy!!!'
42    WRITE (lunout, *) '  in the dynamics punjours=', punjours
43    WRITE (lunout, *) '   but in the physics RDAY=', rday
44    IF (abs(rday-punjours)>0.01*punjours) THEN
45        ! stop here if the relative difference is more than 1%
46      abort_message = 'length of day discrepancy'
47      CALL abort_physic(modname, abort_message, 1)
48    END IF
49  END IF
50  IF (rg/=pg) THEN
51    WRITE (lunout, *) 'inifis: gravity discrepancy !!!'
52    WRITE (lunout, *) '     in the dynamics pg=', pg
53    WRITE (lunout, *) '  but in the physics RG=', rg
54    IF (abs(rg-pg)>0.01*pg) THEN
55        ! stop here if the relative difference is more than 1%
56      abort_message = 'gravity discrepancy'
57      CALL abort_physic(modname, abort_message, 1)
58    END IF
59  END IF
60  IF (ra/=prad) THEN
61    WRITE (lunout, *) 'inifis: planet radius discrepancy !!!'
62    WRITE (lunout, *) '   in the dynamics prad=', prad
63    WRITE (lunout, *) '  but in the physics RA=', ra
64    IF (abs(ra-prad)>0.01*prad) THEN
65        ! stop here if the relative difference is more than 1%
66      abort_message = 'planet radius discrepancy'
67      CALL abort_physic(modname, abort_message, 1)
68    END IF
69  END IF
70  IF (rd/=pr) THEN
71    WRITE (lunout, *) 'inifis: reduced gas constant discrepancy !!!'
72    WRITE (lunout, *) '     in the dynamics pr=', pr
73    WRITE (lunout, *) '  but in the physics RD=', rd
74    IF (abs(rd-pr)>0.01*pr) THEN
75        ! stop here if the relative difference is more than 1%
76      abort_message = 'reduced gas constant discrepancy'
77      CALL abort_physic(modname, abort_message, 1)
78    END IF
79  END IF
80  IF (rcpd/=pcpp) THEN
81    WRITE (lunout, *) 'inifis: specific heat discrepancy !!!'
82    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
83    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
84    IF (abs(rcpd-pcpp)>0.01*pcpp) THEN
85        ! stop here if the relative difference is more than 1%
86      abort_message = 'specific heat discrepancy'
87      CALL abort_physic(modname, abort_message, 1)
88    END IF
89  END IF
90
91  END SUBROUTINE inifis
92 
93END MODULE inifis_mod
Note: See TracBrowser for help on using the repository browser.