source: codes/icosagcm/trunk/src/time.f90 @ 295

Last change on this file since 295 was 295, checked in by ymipsl, 10 years ago

Merging OpenMP parallisme mode : by subdomain and on vertical level.
This feature is actually experimental but may be retro-compatible with the last method based only on subdomain

YM

File size: 4.9 KB
Line 
1MODULE time_mod
2  use prec
3  PRIVATE
4
5  INTEGER,SAVE :: ncid
6!$OMP THREADPRIVATE(ncid) 
7  INTEGER,SAVE :: time_counter_id
8!$OMP THREADPRIVATE(time_counter_id) 
9  INTEGER,SAVE :: it
10!$OMP THREADPRIVATE(it) 
11
12  INTEGER,SAVE :: itau0=0
13!$OMP THREADPRIVATE(itau0) 
14
15  REAL(rstd),SAVE :: dt
16!$OMP THREADPRIVATE(dt) 
17  REAL(rstd),SAVE :: write_period
18!$OMP THREADPRIVATE(write_period) 
19  INTEGER,SAVE    :: itau_out, itau_adv, itau_dissip, itau_physics, itaumax
20!$OMP THREADPRIVATE(itau_out, itau_adv, itau_dissip, itau_physics, itaumax) 
21
22  INTEGER,SAVE    :: itau_check_conserv
23!$OMP THREADPRIVATE(itau_check_conserv) 
24 
25  INTEGER,SAVE :: day_step,ndays
26!$OMP THREADPRIVATE(day_step,ndays) 
27  REAL(rstd),SAVE :: jD_ref,jH_ref
28!$OMP THREADPRIVATE(jD_ref,jH_ref) 
29  INTEGER,SAVE :: day_ini,day_end,annee_ref,day_ref
30!$OMP THREADPRIVATE(day_ini,day_end,annee_ref,day_ref) 
31  REAL(rstd),SAVE::start_time
32!$OMP THREADPRIVATE(start_time) 
33  CHARACTER(LEN=255) :: time_style
34!$OMP THREADPRIVATE(time_style) 
35  INTEGER,SAVE:: an, mois, jour
36!$OMP THREADPRIVATE(an, mois, jour) 
37  REAL(rstd),SAVE:: heure
38!$OMP THREADPRIVATE(heure) 
39  CHARACTER (LEN=10):: calend
40!$OMP THREADPRIVATE(calend) 
41
42  PUBLIC create_time_counter_header, update_time_counter, close_time_counter, init_time,  &
43         dt, write_period, itau_out, itau_adv, itau_dissip, itau_physics, itaumax,  &
44         itau_check_conserv,  & 
45         day_step,ndays,jD_ref,jH_ref,day_ini,day_end,annee_ref,day_ref, &
46         an, mois, jour,heure, calend,time_style,itau0
47
48
49
50
51CONTAINS
52 
53  SUBROUTINE init_time
54    USE earth_const
55    USE getin_mod
56    USE mpipara
57    IMPLICIT NONE
58    REAL(rstd) :: run_length
59   
60    dt=90.
61    CALL getin('dt',dt)
62    write_period=0
63    CALL getin('write_period',write_period)
64    itaumax=100
65    CALL getin('itaumax',itaumax)   
66    run_length=dt*itaumax
67    CALL getin('run_length',run_length)
68    itaumax=run_length/dt
69   
70    time_style='dcmip'
71    CALL getin('time_style',time_style)
72    SELECT CASE(TRIM(time_style))
73    CASE('none') ! do nothing
74    CASE('dcmip') ! rescale time step for small-planet experiments
75       dt=dt/scale_factor       
76       write_period=write_period/scale_factor
77       IF (is_mpi_root) PRINT *, 'Output frequency (scaled) set to ',write_period
78    CASE DEFAULT
79       IF (is_mpi_root) PRINT*,"Bad selector for variable time_style >",TRIM(time_style),"> options are <none>, <dcmip>"
80       STOP
81    END SELECT
82   
83    itau_out=FLOOR(.5+write_period/dt)
84    IF (is_mpi_root) PRINT *, 'Output frequency itau_out = ',itau_out
85
86    itau_adv=1
87    CALL getin('itau_adv',itau_adv)
88
89    itau_dissip=1
90    CALL getin('itau_dissip',itau_dissip)
91
92    itau_physics=1
93    CALL getin('itau_physics',itau_physics)
94
95    itau_check_conserv=HUGE(itau_check_conserv)
96    CALL getin('itau_check_conserv',itau_check_conserv)
97
98    IF (is_mpi_root)  THEN
99       PRINT *, 'itaumax=',itaumax
100       PRINT *, 'itau_adv=',itau_adv, 'itau_dissip=',itau_dissip, 'itau_physics=',itau_physics
101    END IF
102   
103    CALL create_time_counter_header
104   
105  END SUBROUTINE init_time
106
107  SUBROUTINE create_time_counter_header
108  USE netcdf_mod
109  USE prec
110  USE getin_mod
111  USE mpipara
112  IMPLICIT NONE
113  INTEGER :: status
114  INTEGER :: timeid, dtid
115  REAL(rstd) :: dt
116  CHARACTER(LEN=255) :: time_frequency
117
118  CALL getin("dt",dt)
119
120!$OMP BARRIER
121!$OMP MASTER 
122    IF (is_mpi_root) THEN
123      status = NF90_CREATE('time_counter.nc', NF90_CLOBBER, ncid)
124      status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeid)
125      status = NF90_DEF_VAR(ncid,'time_counter',NF90_DOUBLE,(/ timeid /),time_counter_id)
126      status = NF90_PUT_ATT(ncid,time_counter_id,"long_name","time")
127      status = NF90_PUT_ATT(ncid,time_counter_id,"units","seconds since 2000-01-01 00:00:00")
128      status = NF90_PUT_ATT(ncid,time_counter_id,"calendar","noleap")
129      status = NF90_DEF_VAR(ncid,'mdt',NF90_DOUBLE,varid=dtid)
130
131      WRITE(time_frequency,*) write_period
132      PRINT*,TRIM(time_frequency)
133      status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"time_frequency",TRIM(time_frequency)//"s")
134
135      status = NF90_ENDDEF(ncid) 
136
137      status=NF90_PUT_VAR(ncid,dtid, dt)
138    ENDIF
139    it=0
140!$OMP END MASTER
141!$OMP BARRIER
142
143  END SUBROUTINE create_time_counter_header
144 
145  SUBROUTINE update_time_counter(time)
146  USE netcdf_mod
147  USE mpipara
148  USE prec
149  IMPLICIT NONE
150  REAL(rstd),INTENT(IN) ::time
151  INTEGER :: status
152  REAL(rstd) ::time_array(1)
153
154!$OMP BARRIER
155!$OMP MASTER
156    time_array(1)=time
157 
158    it=it+1
159    IF (is_mpi_root) THEN
160      status=NF90_PUT_VAR(ncid,time_counter_id,time_array,start=(/ it /),count=(/ 1 /))
161      status=NF90_SYNC(ncid)
162    ENDIF
163!$OMP END MASTER
164!$OMP BARRIER
165
166  END SUBROUTINE update_time_counter   
167 
168  SUBROUTINE close_time_counter
169  USE netcdf_mod
170  USE mpipara
171  IMPLICIT NONE
172    INTEGER :: status
173   
174!$OMP BARRIER
175!$OMP MASTER
176     IF (is_mpi_root) status=NF90_CLOSE(ncid)
177!$OMP END MASTER
178!$OMP BARRIER
179   
180  END SUBROUTINE  close_time_counter 
181
182END MODULE time_mod
Note: See TracBrowser for help on using the repository browser.