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 vendors/XMLIO_SERVER/current/src/IOSERVER – NEMO

source: vendors/XMLIO_SERVER/current/src/IOSERVER/mod_interface_ioipsl.f90 @ 2765

Last change on this file since 2765 was 2765, checked in by smasson, 13 years ago

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