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 @ 1897

Last change on this file since 1897 was 1897, checked in by flavoni, 14 years ago

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