GCC Code Coverage Report


Directory: ./
File: phys/time_phylmdz_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 30 32 93.8%
Branches: 2 4 50.0%

Line Branch Exec Source
1 !
2 ! $Id: time_phylmdz_mod.F90 2805 2017-03-01 16:50:11Z fairhead $
3 !
4 MODULE time_phylmdz_mod
5
6 IMPLICIT NONE
7 REAL,SAVE :: pdtphys ! physics time step (s)
8 !$OMP THREADPRIVATE(pdtphys)
9 INTEGER,SAVE :: day_step_phy ! number of physical steps per day
10 !$OMP THREADPRIVATE(day_step_phy)
11 INTEGER,SAVE :: ndays ! number of days to run
12 !$OMP THREADPRIVATE(ndays)
13 INTEGER,SAVE :: annee_ref ! reference year from the origin
14 !$OMP THREADPRIVATE(annee_ref)
15 INTEGER,SAVE :: day_ref ! reference year of the origin
16 !$OMP THREADPRIVATE(day_ref)
17 INTEGER,SAVE :: day_ini ! initial day of the run starting from 1st january of annee_ref
18 !$OMP THREADPRIVATE(day_ini)
19 INTEGER,SAVE :: day_end ! final day of the run starting from 1st january of annee_ref
20 !$OMP THREADPRIVATE(day_end)
21 REAL,SAVE :: start_time ! starting time from the begining of the initial day
22 !$OMP THREADPRIVATE(start_time)
23 INTEGER,SAVE :: raz_date
24 !$OMP THREADPRIVATE(raz_date)
25
26 INTEGER,SAVE :: itau_phy ! number of physiq iteration from origin
27 !$OMP THREADPRIVATE(itau_phy)
28 INTEGER,SAVE :: itaufin_phy ! final iteration (in itau_phy steps)
29 !$OMP THREADPRIVATE(itaufin_phy)
30 REAL,SAVE :: current_time ! current elapsed time in seconds from the begining of the run
31 !$OMP THREADPRIVATE(current_time)
32
33
34 CONTAINS
35
36 481 SUBROUTINE init_time(annee_ref_, day_ref_, day_ini_, start_time_, &
37 ndays_, pdtphys_)
38 USE ioipsl_getin_p_mod, ONLY : getin_p
39 USE phys_cal_mod, ONLY: phys_cal_init
40 IMPLICIT NONE
41 INCLUDE 'YOMCST.h'
42 INTEGER, INTENT(IN) :: annee_ref_
43 INTEGER, INTENT(IN) :: day_ref_
44 INTEGER, INTENT(IN) :: day_ini_
45 REAL, INTENT(IN) :: start_time_
46 INTEGER, INTENT(IN) :: ndays_
47 REAL, INTENT(IN) :: pdtphys_
48
49 1 annee_ref = annee_ref_
50 1 day_ref = day_ref_
51 1 day_ini = day_ini_
52 1 start_time = start_time_
53 1 ndays = ndays_
54 1 pdtphys = pdtphys_
55
56 ! Initialize module variable not inherited from dynamics
57 1 day_step_phy = NINT(rday/pdtphys)
58 1 day_end = day_ini + ndays
59
60 1 raz_date = 0
61 1 CALL getin_p('raz_date', raz_date)
62
63 1 current_time=0.
64
65 1 CALL phys_cal_init(annee_ref,day_ref)
66
67 1 END SUBROUTINE init_time
68
69 1 SUBROUTINE init_iteration(itau_phy_)
70 IMPLICIT NONE
71 INTEGER, INTENT(IN) :: itau_phy_
72 1 itau_phy=itau_phy_
73
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (raz_date==1) itau_phy=0
74
75 1 itaufin_phy=itau_phy+NINT(ndays/pdtphys)
76
77 1 END SUBROUTINE init_iteration
78
79 480 SUBROUTINE update_time(pdtphys_)
80 ! This subroutine updates the module saved variables.
81 USE ioipsl, ONLY : ymds2ju
82 USE phys_cal_mod, ONLY: phys_cal_update
83 USE print_control_mod, ONLY: lunout
84 IMPLICIT NONE
85 INCLUDE 'YOMCST.h'
86 REAL,INTENT(IN) :: pdtphys_
87 REAL :: julian_date
88 INTEGER :: cur_day
89 REAL :: cur_sec
90
91 ! Check if the physics timestep has changed
92
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF ( ABS( (pdtphys-pdtphys_) / ((pdtphys+pdtphys_)/2))> 10.*EPSILON(pdtphys_)) THEN
93 WRITE(lunout,*) "WARNING ! Physics time step changes from a call to the next",pdtphys_,pdtphys
94 WRITE(lunout,*) "Not sure the physics parametrizations can handle this..."
95 ENDIF
96 480 pdtphys=pdtphys_
97
98 ! Update elapsed time since begining of run:
99 480 current_time = current_time + pdtphys
100 480 cur_day = int(current_time/rday)
101 480 cur_sec = current_time - (cur_day * rday)
102
103 ! Compute corresponding Julian date and update calendar
104 480 cur_day = cur_day + day_ini
105 480 cur_sec = cur_sec + (start_time * rday)
106 480 CALL ymds2ju(annee_ref,1, cur_day, cur_sec, julian_date)
107 480 CALL phys_cal_update(julian_date)
108
109 480 END SUBROUTINE update_time
110
111 END MODULE time_phylmdz_mod
112
113