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

Annotation of /trunk/IOIPSL/histwrite_real.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 56 - (hide annotations)
Tue Jan 10 19:02:02 2012 UTC (12 years, 4 months ago) by guez
Original Path: trunk/libf/IOIPSL/histwrite_real.f90
File size: 7679 byte(s) 
Imported "writehist.f" from LMDZ.

Moved module variable "histaveid" from "com_io_dyn" to "initdynav_m".

In "inithist", access directly module variables from "com_io_dyn"
instead of going through the arguments. Copying from LMDZ, write "u"
and scalar variables to separate files. Create a new variable for the
new file in "com_io_dyn". Copying from LMDZ, change the vertical axes
of the three files.

Removed some useless initializations in "dissip".

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