/[lmdze]/trunk/IOIPSL/Histcom/histend.f
ViewVC logotype

Contents of /trunk/IOIPSL/Histcom/histend.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 91 - (show annotations)
Wed Mar 26 17:18:58 2014 UTC (10 years, 2 months ago) by guez
File size: 6236 byte(s) 
Removed unused variables lock_startdate and time_stamp of module
calendar.

Noticed that physiq does not change the surface pressure. So removed
arguments ps and dpfi of subroutine addfi. dpfi was always 0. The
computation of ps in addfi included some averaging at the poles. In
principle, this does not change ps but in practice it does because of
finite numerical precision. So the results of the simulation are
changed. Removed arguments ps and dpfi of calfis. Removed argument
d_ps of physiq.

du at the poles is not computed by dudv1, so declare only the
corresponding latitudes in dudv1. caldyn passes only a section of the
array dudyn as argument.

Removed variable niadv of module iniadvtrac_m.

Declared arguments of exner_hyb as assumed-shape arrays and made all
other horizontal sizes in exner_hyb dynamic. This allows the external
program test_disvert to use exner_hyb at a single horizontal position.
1 module histend_m
2
3 implicit none
4
5 contains
6
7 SUBROUTINE histend(fileid)
8
9 ! This subroutine ends the declaration of variables, sets the time
10 ! axes in the NetCDF file and puts it into write mode.
11
12 USE calendar, ONLY: ju2ymds
13 USE errioipsl, ONLY: histerr
14 USE histcom_var, ONLY: date0, freq_opp, freq_wrt, fullop, &
15 missing_val, name, nb_tax, nb_var, ncdf_ids, ncvar_ids, regular, &
16 tax_name, tdimid, tid, title, topp, unit_name, var_axid, var_zaxid, &
17 xid, yid, zax_ids, zax_name
18 USE ioget_calendar_m, ONLY: ioget_calendar
19 USE ioipslmpp, ONLY: ioipslmpp_addatt
20 USE netcdf, ONLY: nf90_float, nf90_unlimited
21 use netcdf95, only: nf95_def_dim, nf95_def_var, nf95_put_att, nf95_enddef
22
23 INTEGER, INTENT(IN):: fileid ! ID of the file to be worked on
24
25 ! Local:
26 INTEGER ncid, varid
27 INTEGER iret, ndim, iv, itx, ziv
28 INTEGER itax
29 INTEGER dims(4), dim_cnt
30 INTEGER year, month, day, hours, minutes
31 REAL sec
32 REAL rtime0
33 CHARACTER(len=20) tname, tunit
34 CHARACTER(len=30) str30
35 CHARACTER(len=80) ttitle
36 CHARACTER(len=120) assoc
37 CHARACTER(len=70) str70
38 CHARACTER(len=3):: cal(12) = (/ 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', &
39 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/)
40 CHARACTER(len=7) tmp_opp
41
42 !---------------------------------------------------------------------
43
44 ncid = ncdf_ids(fileid)
45
46 ! 1.0 Create the time axes
47
48 call nf95_def_dim(ncid, 'time_counter', nf90_unlimited, tid(fileid))
49
50 ! 1.1 Define all the time axes needed for this file
51
52 DO itx = 1, nb_tax(fileid)
53 IF (nb_tax(fileid)>1) THEN
54 str30 = 't_' // tax_name(fileid, itx)
55 ELSE
56 str30 = 'time_counter'
57 END IF
58 call nf95_def_var(ncid, str30, nf90_float, tid(fileid), &
59 tdimid(fileid, itx))
60
61 rtime0 = date0(fileid)
62 CALL ju2ymds(rtime0, year, month, day, sec)
63
64 ! Catch any error induced by a change in calendar
65
66 IF (year < 0) THEN
67 year = 2000 + year
68 END IF
69
70 hours = int(sec/(60.*60.))
71 minutes = int((sec-hours*60.*60.)/60.)
72 sec = sec - (hours*60.*60.+minutes*60.)
73
74 WRITE(str70, 7000) year, month, day, hours, minutes, int(sec)
75 call nf95_put_att(ncid, tdimid(fileid, itx), 'units', trim(str70))
76
77 CALL ioget_calendar(str30)
78 call nf95_put_att(ncid, tdimid(fileid, itx), 'calendar', trim(str30))
79
80 call nf95_put_att(ncid, tdimid(fileid, itx), 'title', 'Time')
81
82 call nf95_put_att(ncid, tdimid(fileid, itx), 'long_name', &
83 'Time axis')
84
85 WRITE(str70, 7001) year, cal(month), day, hours, minutes, int(sec)
86 call nf95_put_att(ncid, tdimid(fileid, itx), 'time_origin', &
87 trim(str70))
88 END DO
89
90 ! 2.0 declare the variables
91
92 DO iv = 1, nb_var(fileid)
93
94 itax = var_axid(fileid, iv)
95
96 tname = name(fileid, iv)
97 tunit = unit_name(fileid, iv)
98 ttitle = title(fileid, iv)
99
100 IF (regular(fileid)) THEN
101 dims(1:2) = (/ xid(fileid), yid(fileid) /)
102 dim_cnt = 2
103 ELSE
104 dims(1) = xid(fileid)
105 dim_cnt = 1
106 END IF
107
108 tmp_opp = topp(fileid, iv)
109 ziv = var_zaxid(fileid, iv)
110
111 ! 2.1 dimension of field
112
113 IF ((trim(tmp_opp)/='never')) THEN
114 IF ((trim(tmp_opp)/='once') .AND. (trim( &
115 tmp_opp)/='l_max') .AND. (trim(tmp_opp)/='l_min')) THEN
116 IF (ziv==-99) THEN
117 ndim = dim_cnt + 1
118 dims(dim_cnt+1:dim_cnt+2) = (/ tid(fileid), 0 /)
119 ELSE
120 ndim = dim_cnt + 2
121 dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(fileid, ziv), &
122 tid(fileid) /)
123 END IF
124 ELSE
125 IF (ziv==-99) THEN
126 ndim = dim_cnt
127 dims(dim_cnt+1:dim_cnt+2) = (/ 0, 0 /)
128 ELSE
129 ndim = dim_cnt + 1
130 dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(fileid, ziv), 0 /)
131 END IF
132 END IF
133
134 call nf95_def_var(ncid, trim(tname), nf90_float, dims(1:abs(ndim)), &
135 varid)
136
137 ncvar_ids(fileid, iv) = varid
138
139 call nf95_put_att(ncid, varid, 'units', trim(tunit))
140 call nf95_put_att(ncid, varid, 'missing_value', missing_val)
141 call nf95_put_att(ncid, varid, 'long_name', trim(ttitle))
142 call nf95_put_att(ncid, varid, 'short_name', trim(tname))
143 call nf95_put_att(ncid, varid, 'online_operation', trim(fullop( &
144 fileid, iv)))
145
146 SELECT CASE (ndim)
147 CASE (-3)
148 str30 = 'ZYX'
149 CASE (2)
150 str30 = 'YX'
151 CASE (3)
152 str30 = 'TYX'
153 CASE (4)
154 str30 = 'TZYX'
155 CASE DEFAULT
156 CALL histerr(3, 'histend', &
157 'less than 2 or more than 4 dimensions are not', &
158 'allowed at this stage', ' ')
159 END SELECT
160
161 call nf95_put_att(ncid, varid, 'axis', trim(str30))
162
163 assoc = 'nav_lat nav_lon'
164 ziv = var_zaxid(fileid, iv)
165 IF (ziv>0) THEN
166 str30 = zax_name(fileid, ziv)
167 assoc = trim(str30) // ' ' // trim(assoc)
168 END IF
169
170 IF (itax>0) THEN
171 IF (nb_tax(fileid)>1) THEN
172 str30 = 't_' // tax_name(fileid, itax)
173 ELSE
174 str30 = 'time_counter'
175 END IF
176 assoc = trim(str30) // ' ' // trim(assoc)
177
178 call nf95_put_att(ncid, varid, 'interval_operation', &
179 real(freq_opp(fileid, iv)))
180 call nf95_put_att(ncid, varid, 'interval_write', &
181 real(freq_wrt(fileid, iv)))
182 END IF
183 call nf95_put_att(ncid, varid, 'associate', trim(assoc))
184 END IF
185 END DO
186
187 ! Add MPP attributes
188 CALL ioipslmpp_addatt(ncid)
189
190 ! 3.0 Put the netcdf file into write mode
191 call nf95_enddef(ncid)
192
193 7000 FORMAT ('seconds since ', I4.4, '-', I2.2, '-', I2.2, ' ', I2.2, ':', &
194 I2.2, ':', I2.2)
195 7001 FORMAT (' ', I4.4, '-', A3, '-', I2.2, ' ', I2.2, ':', I2.2, ':', I2.2)
196
197 END SUBROUTINE histend
198
199 end module histend_m
  ViewVC Help
Powered by ViewVC 1.1.21