/[lmdze]/trunk/IOIPSL/histwrite_real.f
ViewVC logotype

Annotation of /trunk/IOIPSL/histwrite_real.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 104 - (hide annotations)
Thu Sep 4 10:05:52 2014 UTC (9 years, 8 months ago) by guez
File size: 6979 byte(s) 
Removed procedure sortvarc0. Called sortvarc with an additional
argument resetvarc instead. (Following LMDZ.) Moved current time
computations and some printing statements from sortvarc to
caldyn. Could then remove arguments itau and time_0 of sortvarc, and
could remove "use dynetat0". Better to keep "dynetat0.f" as a gcm-only
file.

Moved some variables from module ener to module sortvarc.

Split file "mathelp.f" into single-procedure files.

Removed unused argument nadv of adaptdt. Removed dimension arguments
of bernoui.

Removed unused argument nisurf of interfoce_lim. Changed the size of
argument lmt_sst of interfoce_lim from klon to knon. Removed case when
newlmt is false.

dynredem1 is called only once in each run, either ce0l or gcm. So
variable nb in call to nf95_put_var was always 1. Removed variable nb.

Removed dimension arguments of calcul_fluxs. Removed unused arguments
precip_rain, precip_snow, snow of calcul_fluxs. Changed the size of
all the arrays in calcul_fluxs from klon to knon.

Removed dimension arguments of fonte_neige. Changed the size of all
the arrays in fonte_neige from klon to knon.

Changed the size of arguments tsurf and tsurf_new of interfsurf_hq
from klon to knon. Changed the size of argument ptsrf of soil from
klon to knon.
1 guez 45 module histwrite_real_m
2    
3     implicit none
4    
5     contains
6    
7 guez 62 SUBROUTINE histwrite_real(fileid, varid, itau, nbdpt, buff_tmp, nbindex, &
8 guez 45 nindex, do_oper, do_write)
9    
10     ! This subroutine is internal and does the calculations and writing
11     ! if needed. At a later stage it should be split into an operation
12     ! and writing subroutines.
13    
14 guez 62 USE histcom_var, ONLY: buffer, buff_pos, datasz_max, deltat, &
15     last_opp, last_wrt, missing_val, nbopp, nb_opp, nb_wrt, ncdf_ids, &
16     ncvar_ids, point, regular, scal, scsize, sopps, tax_last, tdimid, &
17     topp, var_axid, zorig, zsize
18 guez 104 USE trans_buff_m, ONLY: trans_buff
19     use moycum_m, only: moycum
20 guez 67 USE mathop_m, ONLY: mathop
21     use netcdf, only: NF90_PUT_VAR
22 guez 45
23 guez 62 INTEGER, INTENT(IN):: fileid, varid, itau, nbdpt
24     REAL buff_tmp(:)
25 guez 56
26 guez 62 INTEGER, INTENT(IN):: nbindex
27 guez 56 ! number of indices provided
28     ! If it is equal to the size of the full field as provided in histdef
29     ! then nothing is done.
30    
31 guez 62 INTEGER, INTENT(IN):: nindex(nbindex)
32 guez 56 ! The indices used to expand the variable (pdata) onto the full field
33    
34 guez 62 LOGICAL, INTENT(IN):: do_oper, do_write
35 guez 45
36 guez 62 ! Local:
37 guez 45
38 guez 62 INTEGER:: tsz, ncid, ncvarid
39     INTEGER:: i, iret, ipt, itax
40     INTEGER:: io, nbin, nbout
41     INTEGER, DIMENSION(4):: corner, edges
42     INTEGER:: itime
43 guez 45
44 guez 62 REAL:: rtime
45     CHARACTER(LEN=7):: tmp_opp
46 guez 45
47 guez 62 REAL, ALLOCATABLE, SAVE:: buff_tmp2(:)
48     INTEGER, SAVE:: buff_tmp2_sz
49     REAL, ALLOCATABLE, SAVE:: buffer_used(:)
50     INTEGER, SAVE:: buffer_sz
51    
52 guez 45 !--------------------------------------------------------------------
53    
54     ! The sizes which can be encoutered
55    
56 guez 67 tsz = zsize(fileid, varid, 1) * zsize(fileid, varid, 2) &
57     * zsize(fileid, varid, 3)
58 guez 45
59     ! 1.0 We allocate the memory needed to store the data between write
60 guez 67 ! and the temporary space needed for operations.
61     ! We have to keep precedent buffer if needed
62 guez 45
63     IF (.NOT. ALLOCATED(buffer)) THEN
64     ALLOCATE(buffer(buff_pos))
65     buffer_sz = buff_pos
66     buffer(:)=0.0
67     ELSE IF (buffer_sz < buff_pos) THEN
68     IF (SUM(buffer)/=0.0) THEN
69 guez 67 ALLOCATE(buffer_used(buffer_sz))
70 guez 45 buffer_used(:)=buffer(:)
71 guez 67 DEALLOCATE(buffer)
72     ALLOCATE(buffer(buff_pos))
73 guez 45 buffer_sz = buff_pos
74     buffer(:SIZE(buffer_used))=buffer_used
75 guez 67 DEALLOCATE(buffer_used)
76 guez 45 ELSE
77 guez 67 DEALLOCATE(buffer)
78     ALLOCATE(buffer(buff_pos))
79 guez 45 buffer_sz = buff_pos
80     buffer(:)=0.0
81     ENDIF
82     ENDIF
83    
84     ! The buffers are only deallocated when more space is needed. This
85     ! reduces the umber of allocates but increases memory needs.
86    
87     IF (.NOT.ALLOCATED(buff_tmp2)) THEN
88 guez 67 ALLOCATE(buff_tmp2(datasz_max(fileid, varid)))
89 guez 62 buff_tmp2_sz = datasz_max(fileid, varid)
90 guez 67 ELSE IF (datasz_max(fileid, varid) > buff_tmp2_sz) THEN
91     DEALLOCATE(buff_tmp2)
92     ALLOCATE(buff_tmp2(datasz_max(fileid, varid)))
93 guez 62 buff_tmp2_sz = datasz_max(fileid, varid)
94 guez 45 ENDIF
95    
96 guez 62 rtime = itau * deltat(fileid)
97     tmp_opp = topp(fileid, varid)
98 guez 45
99     ! 3.0 Do the operations or transfer the slab of data into buff_tmp
100    
101     ! 3.1 DO the Operations only if needed
102    
103 guez 67 IF (do_oper) THEN
104 guez 62 i = fileid
105 guez 45 nbout = nbdpt
106    
107 guez 67 ! 3.4 We continue the sequence of operations
108     ! we started in the interface routine
109 guez 45
110     DO io = 2, nbopp(i, varid), 2
111     nbin = nbout
112     nbout = datasz_max(i, varid)
113     CALL mathop(sopps(i, varid, io), nbin, buff_tmp, missing_val, &
114 guez 62 nbindex, nindex, scal(i, varid, io), nbout, buff_tmp2)
115 guez 45
116     nbin = nbout
117     nbout = datasz_max(i, varid)
118     CALL mathop(sopps(i, varid, io+1), nbin, buff_tmp2, missing_val, &
119 guez 62 nbindex, nindex, scal(i, varid, io+1), nbout, buff_tmp)
120 guez 45 ENDDO
121    
122 guez 67 ! 3.5 Zoom into the data
123 guez 45
124 guez 67 CALL trans_buff(zorig(i, varid, 1), zsize(i, varid, 1), &
125     zorig(i, varid, 2), zsize(i, varid, 2), zorig(i, varid, 3), &
126     zsize(i, varid, 3), scsize(i, varid, 1), scsize(i, varid, 2), &
127     scsize(i, varid, 3), buff_tmp, buff_tmp2_sz, buff_tmp2)
128 guez 45
129 guez 67 ! 5.0 Do the operations if needed. In the case of instantaneous
130     ! output we do not transfer to the buffer.
131 guez 45
132 guez 62 ipt = point(fileid, varid)
133 guez 45
134 guez 67 IF ((TRIM(tmp_opp) /= "inst") &
135     .AND.(TRIM(tmp_opp) /= "once")) THEN
136 guez 45 CALL moycum(tmp_opp, tsz, buffer(ipt:), &
137 guez 62 buff_tmp2, nb_opp(fileid, varid))
138 guez 45 ENDIF
139    
140 guez 62 last_opp(fileid, varid) = itau
141     nb_opp(fileid, varid) = nb_opp(fileid, varid)+1
142 guez 45
143     ENDIF
144    
145     ! 6.0 Write to file if needed
146    
147 guez 67 IF (do_write) THEN
148 guez 62 ncvarid = ncvar_ids(fileid, varid)
149     ncid = ncdf_ids(fileid)
150 guez 45
151 guez 67 ! 6.1 Do the operations that are needed before writting
152     IF ((TRIM(tmp_opp) /= "inst") .AND. (TRIM(tmp_opp) /= "once")) THEN
153     rtime = (rtime + last_wrt(fileid, varid)*deltat(fileid)) / 2.
154 guez 45 ENDIF
155    
156 guez 67 ! 6.2 Add a value to the time axis of this variable if needed
157     IF (TRIM(tmp_opp) /= "l_max" .AND. TRIM(tmp_opp) /= "l_min" &
158     .AND. TRIM(tmp_opp) /= "once") THEN
159 guez 62 itax = var_axid(fileid, varid)
160 guez 67 itime = nb_wrt(fileid, varid) + 1
161 guez 45
162 guez 62 IF (tax_last(fileid, itax) < itime) THEN
163 guez 67 iret = NF90_PUT_VAR(ncid, tdimid(fileid, itax), (/rtime/), &
164     start=(/itime/))
165 guez 62 tax_last(fileid, itax) = itime
166 guez 45 ENDIF
167     ELSE
168     itime=1
169     ENDIF
170    
171 guez 67 ! 6.3 Write the data. Only in the case of instantaneous output
172     ! we do not write the buffer.
173 guez 45
174 guez 62 IF (scsize(fileid, varid, 3) == 1) THEN
175     IF (regular(fileid)) THEN
176 guez 67 corner(1:4) = (/1, 1, itime, 0/)
177     edges(1:4) = (/zsize(fileid, varid, 1), &
178 guez 62 zsize(fileid, varid, 2), &
179 guez 67 1, 0/)
180 guez 45 ELSE
181 guez 67 corner(1:4) = (/1, itime, 0, 0/)
182     edges(1:4) = (/zsize(fileid, varid, 1), 1, 0, 0/)
183 guez 45 ENDIF
184     ELSE
185 guez 67 IF (regular(fileid)) THEN
186     corner(1:4) = (/1, 1, 1, itime/)
187     edges(1:4) = (/zsize(fileid, varid, 1), &
188 guez 62 zsize(fileid, varid, 2), &
189 guez 67 zsize(fileid, varid, 3), 1/)
190 guez 45 ELSE
191 guez 67 corner(1:4) = (/1, 1, itime, 0/)
192     edges(1:4) = (/zsize(fileid, varid, 1), &
193     zsize(fileid, varid, 3), 1, 0/)
194 guez 45 ENDIF
195     ENDIF
196    
197 guez 62 ipt = point(fileid, varid)
198 guez 45
199 guez 67 IF ((TRIM(tmp_opp) /= "inst") .AND. (TRIM(tmp_opp) /= "once")) THEN
200     iret = NF90_PUT_VAR(ncid, ncvarid, buffer(ipt:), &
201 guez 62 start=corner(1:4), count=edges(1:4))
202 guez 45 ELSE
203 guez 67 iret = NF90_PUT_VAR(ncid, ncvarid, buff_tmp2, &
204 guez 62 start=corner(1:4), count=edges(1:4))
205 guez 45 ENDIF
206    
207 guez 62 last_wrt(fileid, varid) = itau
208     nb_wrt(fileid, varid) = nb_wrt(fileid, varid)+1
209     nb_opp(fileid, varid) = 0
210 guez 45 ENDIF
211 guez 62
212 guez 45 END SUBROUTINE histwrite_real
213    
214     end module histwrite_real_m
  ViewVC Help
Powered by ViewVC 1.1.21