New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
mod_interface_ioipsl.f90 in trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER – NEMO

source: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_interface_ioipsl.f90 @ 3345

Last change on this file since 3345 was 3345, checked in by acc, 12 years ago

trunk bugfix for #943. Reinstating changes to XMLIO_SERVER module (mod_interface_ioipsl.f90) to ensure netcdf4 files are produced when requested. Prior to this fix, v3.4 would produce netCDF-3 mean files regardless of logical flags when key_iomput was used with key_netcdf4
  • Property svn:keywords set to Id
File size: 8.8 KB
Line 
1MODULE mod_interface_ioipsl
2
3 
4  INTEGER,PARAMETER     :: id_file=1
5
6
7CONTAINS
8
9  SUBROUTINE init_interface_ioipsl
10  USE xmlio
11  IMPLICIT NONE
12 
13   
14  END SUBROUTINE init_interface_ioipsl
15
16  SUBROUTINE set_calendar(str_calendar)
17  USE ioipsl
18    CHARACTER(LEN=*) :: str_calendar
19   
20    CALL ioconf_calendar(str_calendar)
21   
22  END SUBROUTINE set_calendar
23 
24 
25  SUBROUTINE set_time_parameters(ini_timestep0,zjulian0,timestep0)
26  USE xmlio
27  IMPLICIT NONE
28    INTEGER :: ini_timestep0
29    REAL :: zjulian0, timestep0
30
31    timestep_value=timestep0
32    initial_timestep=ini_timestep0
33    initial_date=zjulian0
34
35  END SUBROUTINE set_time_parameters
36
37  SUBROUTINE Create_file_definition(nb_server,server_rank)
38  USE ioipsl
39  USE xmlio
40  USE mod_ioserver_namelist
41  IMPLICIT NONE
42    INTEGER,INTENT(IN)  :: nb_server
43    INTEGER,INTENT(IN)  :: server_rank
44   
45    TYPE(file_dep),POINTER :: pt_file_dep
46    TYPE(file),POINTER     :: pt_file
47    TYPE(field),POINTER    :: pt_field
48    TYPE(grid),POINTER     :: pt_grid
49    TYPE(zoom),POINTER     :: pt_zoom
50    TYPE(axis),POINTER     :: pt_axis
51    TYPE(domain),POINTER   :: pt_domain
52
53    TYPE(sorted_list),POINTER :: axis_id
54    LOGICAL :: found                 
55    INTEGER :: ioipsl_axis_id
56    INTEGER :: ioipsl_file_id
57    INTEGER :: ioipsl_hori_id
58    INTEGER :: ioipsl_domain_id
59    INTEGER :: i,j
60    CHARACTER(LEN=20) :: direction
61    CHARACTER(LEN=255) :: full_name
62    CALL xmlio__close_definition 
63   
64    ALLOCATE(axis_id)
65   
66    DO i=1,file_enabled%size
67     
68      pt_file_dep=>file_enabled%at(i)%pt
69
70      IF (pt_file_dep%fields%size>0) THEN
71        CALL sorted_list__new(axis_id)
72
73        pt_file=>pt_file_dep%file
74     
75        pt_grid=>pt_file_dep%grids%at(1)%pt
76        pt_domain=>pt_grid%domain
77        pt_zoom=>pt_file_dep%zooms%at(1)%pt
78!        print *,TRIM(pt_file%name),' ',TRIM(pt_zoom%id)
79!        print*,'Global --->',pt_zoom%ni_glo,pt_zoom%nj_glo,pt_zoom%ibegin_glo,pt_zoom%jbegin_glo
80!        print*,'Local  --->',pt_zoom%ni_loc,pt_zoom%nj_loc,pt_zoom%ibegin_loc,pt_zoom%jbegin_loc
81     
82        IF (pt_zoom%ni_loc*pt_zoom%nj_loc > 0) THEN
83       
84          full_name=TRIM(pt_file%name)
85          IF (pt_file%has_name_suffix) full_name=TRIM(full_name)//TRIM(pt_file%name_suffix) 
86          IF ( (pt_zoom%ni_loc == pt_zoom%ni_glo) .AND. (pt_zoom%nj_loc == pt_zoom%nj_glo) ) THEN
87
88            CALL histbeg(TRIM(full_name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat, & 
89                       pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,         &
90                       initial_timestep, initial_date, timestep_value,                               &
91                       ioipsl_hori_id, ioipsl_file_id, snc4chunks=snc4ioset)
92           ELSE                                             
93
94            CALL set_ioipsl_domain_id(pt_grid,nb_server,server_rank,ioipsl_domain_id)
95            CALL histbeg(TRIM(full_name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat,  &
96                       pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,          &
97                       initial_timestep, initial_date, timestep_value,                                &
98                       ioipsl_hori_id, ioipsl_file_id,domain_id=ioipsl_domain_id, snc4chunks=snc4ioset)                                             
99         
100           ENDIF
101       
102     
103          DO j=1,pt_file_dep%axis%size
104            pt_axis=>pt_file_dep%axis%at(j)%pt
105            CALL sorted_list__find(axis_id,hash(Pt_axis%name),ioipsl_axis_id,found)
106            IF (.NOT. found) THEN
107              IF (TRIM(pt_axis%name) /= "none") THEN
108             
109                IF (pt_axis%has_positive) THEN
110                  IF (pt_axis%positive) THEN
111                    direction="up"
112                  ELSE
113                    direction="down"
114                  ENDIF
115                ELSE
116                  direction='unknown'
117                ENDIF
118
119                CALL histvert(ioipsl_file_id, TRIM(pt_axis%name),TRIM(pt_axis%description),    &
120                             TRIM(pt_axis%unit), pt_axis%size,pt_axis%values, ioipsl_axis_id,  &
121                           pdirect=direction)
122                CALL sorted_list__add(axis_id,hash(Pt_axis%name),ioipsl_axis_id)
123              ENDIF
124            ENDIF
125         ENDDO
126       
127          DO j=1,pt_file_dep%fields%size
128            pt_field=>pt_file_dep%fields%at(j)%pt
129            IF (pt_field%axis%name=="none") THEN
130              pt_field%internal(id_file)=ioipsl_file_id
131              CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,            &
132                        &  pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,      &
133                        &  ioipsl_hori_id, 1, 1, 1, -99, 32, pt_field%operation,                 &
134                        &  real(pt_field%freq_op), real(pt_file%output_freq) )
135            ELSE
136              pt_field%internal(id_file)=ioipsl_file_id
137              CALL sorted_list__find(axis_id,hash(Pt_field%axis%name),ioipsl_axis_id,found)
138              CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,          &
139                         & pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,    &
140                         & ioipsl_hori_id, pt_field%axis%size, 1, pt_field%axis%size,          &
141                         & ioipsl_axis_id, 32, pt_field%operation, real(pt_field%freq_op),     &
142                         & real(pt_file%output_freq) )
143            ENDIF
144          ENDDO
145          CALL histend(ioipsl_file_id, snc4chunks=snc4ioset)
146        ENDIF
147        CALL sorted_list__delete(axis_id)
148      ENDIF
149    ENDDO
150   
151    DEALLOCATE(axis_id)
152     
153  END SUBROUTINE Create_file_definition 
154
155
156
157   SUBROUTINE write_ioipsl_2d(varname,var)
158   USE ioipsl
159   USE xmlio
160   IMPLICIT NONE
161     CHARACTER(len=*),INTENT(IN) :: varname
162     REAL            ,INTENT(IN) :: var(:,:)
163     
164     TYPE(field_dep),POINTER :: pt_field_base
165     TYPE(field)    ,POINTER :: pt_field
166     INTEGER :: nindex(size(var))
167     INTEGER :: ioipsl_file_id
168     INTEGER :: pos
169     LOGICAL :: found
170     INTEGER :: i
171     
172     CALL sorted_list__find(sorted_id,hash(varname),pos,found)
173
174     IF (found) THEN
175       pt_field_base=>field_id%at(pos)%pt
176     
177       DO i=1,pt_field_base%field_out%size
178         pt_field=>pt_field_base%field_out%at(i)%pt%field
179         IF ( pt_field%zoom%ni_loc * pt_field%zoom%nj_loc > 0) THEN           
180           ioipsl_file_id=pt_field%internal(id_file)
181           CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_number, var, size(var), nindex)
182         ENDIF
183       ENDDO
184     ENDIF
185     
186   END SUBROUTINE write_ioipsl_2d
187       
188     
189   SUBROUTINE write_ioipsl_3d(varname,var)
190   USE ioipsl
191   USE xmlio
192   IMPLICIT NONE
193     CHARACTER(len=*),INTENT(IN) :: varname
194     REAL            ,INTENT(IN) :: var(:,:,:)
195     
196     TYPE(field_dep),POINTER :: pt_field_base
197     TYPE(field)    ,POINTER :: pt_field
198     INTEGER :: nindex(size(var))
199     INTEGER :: ioipsl_file_id
200     INTEGER :: pos
201     LOGICAL :: found
202     INTEGER :: i
203       
204     CALL sorted_list__find(sorted_id,hash(varname),pos,found)
205
206     IF (found) THEN
207       pt_field_base=>field_id%at(pos)%pt
208     
209       DO i=1,pt_field_base%field_out%size
210         pt_field=>pt_field_base%field_out%at(i)%pt%field
211         IF ( pt_field%zoom%ni_loc * pt_field%zoom%nj_loc > 0) THEN           
212           ioipsl_file_id=pt_field%internal(id_file)
213           CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_number, var, size(var), nindex)
214         ENDIF
215       ENDDO
216     ENDIF
217   END SUBROUTINE write_ioipsl_3d
218           
219
220  SUBROUTINE set_timestep(timestep_nb0)
221  USE xmlio
222  IMPLICIT NONE
223    INTEGER,INTENT(IN) :: timestep_nb0
224     
225    timestep_number=timestep_nb0
226
227  END SUBROUTINE set_timestep
228
229
230  SUBROUTINE set_ioipsl_domain_id(pt_grid, nb_server,server_rank,domain_id)
231  USE xmlio
232  USE mod_ioserver_para
233  USE ioipsl
234  IMPLICIT NONE
235    TYPE(grid), POINTER :: pt_grid
236    INTEGER,INTENT(IN)  :: nb_server
237    INTEGER,INTENT(IN)  :: server_rank
238    INTEGER,INTENT(OUT) :: domain_id
239    TYPE(domain), POINTER :: pt_domain
240               
241    INTEGER,DIMENSION(2) :: ddid
242    INTEGER,DIMENSION(2) :: dsg
243    INTEGER,DIMENSION(2) :: dsl
244    INTEGER,DIMENSION(2) :: dpf
245    INTEGER,DIMENSION(2) :: dpl
246    INTEGER,DIMENSION(2) :: dhs
247    INTEGER,DIMENSION(2) :: dhe 
248   
249    pt_domain=>pt_grid%domain
250
251    ddid = (/ 1,2 /)
252    dsg  = (/ pt_grid%ni, pt_grid%nj /)
253    dsl  = (/ pt_domain%ni, pt_domain%nj /)
254    dpf  = (/ pt_domain%ibegin,pt_domain%jbegin /)
255    dpl  = (/ pt_domain%iend, pt_domain%jend /)
256    dhs  = (/ 0,0 /)
257    dhe  = (/ 0,0 /)
258   
259    call flio_dom_set(nb_server,server_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
260                      'BOX',domain_id)
261 
262  END SUBROUTINE set_ioipsl_domain_id
263
264
265  SUBROUTINE ioipsl_finalize
266  USE ioipsl
267  IMPLICIT NONE
268
269    CALL histclo
270   
271  END SUBROUTINE ioipsl_finalize
272 
273END MODULE mod_interface_ioipsl
Note: See TracBrowser for help on using the repository browser.