Changeset 26 for XMLIO_SERVER
- Timestamp:
- 03/27/09 18:02:59 (16 years ago)
- Location:
- XMLIO_SERVER/trunk/src
- Files:
-
- 4 added
- 23 edited
Legend:
- Unmodified
- Added
- Removed
-
XMLIO_SERVER/trunk/src/IOSERVER/mod_event_client.f90
r8 r26 3 3 USE mod_mpi_buffer_client, ONLY : create_request, finalize_request 4 4 USE mod_event_parameters 5 6 LOGICAL, SAVE :: using_server 5 USE mod_ioserver_namelist 7 6 8 7 CONTAINS 9 8 9 SUBROUTINE event__swap_context(id) 10 USE iomanager 11 IMPLICIT NONE 12 CHARACTER(LEN=*),INTENT(IN) :: id 13 14 IF (using_server) THEN 15 CALL create_request(event_id_swap_context) 16 CALL pack(LEN(TRIM(id))) 17 CALL pack(TRIM(id)) 18 CALL Finalize_request 19 ELSE 20 CALL iom__swap_context(TRIM(id)) 21 ENDIF 22 23 END SUBROUTINE event__swap_context 24 25 10 26 SUBROUTINE event__parse_xml_file(filename) 11 27 USE iomanager … … 109 125 END SUBROUTINE event__set_grid_type_nemo 110 126 127 SUBROUTINE event__set_grid_type_lmdz(name,nbp,offset) 128 USE iomanager 129 IMPLICIT NONE 130 CHARACTER(LEN=*),INTENT(IN) :: name 131 INTEGER,INTENT(IN) :: nbp 132 INTEGER,INTENT(IN) :: offset 133 134 IF (using_server) THEN 135 CALL create_request(event_id_set_grid_type_lmdz) 136 CALL pack(LEN(TRIM(name))) 137 CALL pack(TRIM(name)) 138 CALL pack(nbp) 139 CALL pack(offset) 140 CALL Finalize_request 141 ELSE 142 CALL iom__set_grid_type_lmdz(name,nbp,offset) 143 ENDIF 144 145 END SUBROUTINE event__set_grid_type_lmdz 111 146 112 147 SUBROUTINE event__set_time_parameters(itau0,zjulian,zdt) … … 162 197 END SUBROUTINE event__disable_field 163 198 199 SUBROUTINE event__write_field1d(varname,var) 200 USE iomanager 201 IMPLICIT NONE 202 CHARACTER(len=*),INTENT(IN) :: varname 203 REAL, DIMENSION(:),INTENT(IN) :: var 204 205 IF (using_server) THEN 206 CALL create_request(event_id_write_field1d) 207 CALL pack(len(varname)) 208 CALL pack(size(var,1)) 209 CALL pack(varname) 210 CALL pack_field(var) 211 CALL Finalize_request 212 ELSE 213 CALL iom__write_field1d(varname,var) 214 ENDIF 215 216 END SUBROUTINE event__write_field1d 217 164 218 SUBROUTINE event__write_field2d(varname,var) 165 219 USE iomanager -
XMLIO_SERVER/trunk/src/IOSERVER/mod_event_parameters.f90
r8 r26 13 13 INTEGER, PARAMETER :: event_id_enable_field = 111 14 14 INTEGER, PARAMETER :: event_id_disable_field = 112 15 INTEGER, PARAMETER :: event_id_swap_context = 113 16 INTEGER, PARAMETER :: event_id_set_grid_type_lmdz = 114 17 INTEGER, PARAMETER :: event_id_write_field1d = 115 15 18 INTEGER, PARAMETER :: event_id_stop_ioserver = 999 16 19 END MODULE mod_event_parameters -
XMLIO_SERVER/trunk/src/IOSERVER/mod_event_server.f90
r8 r26 20 20 SELECT CASE (event_id) 21 21 22 CASE (event_id_swap_context) 23 CALL event__swap_context 24 22 25 CASE (event_id_parse_xml_file) 23 26 CALL event__parse_xml_file … … 35 38 CALL event__set_grid_type_nemo 36 39 40 CASE (event_id_set_grid_type_lmdz) 41 CALL event__set_grid_type_lmdz 42 37 43 CASE (event_id_set_time_parameters) 38 44 CALL event__set_time_parameters … … 49 55 CASE (event_id_disable_field) 50 56 CALL event__disable_field 57 58 CASE (event_id_write_Field1d) 59 CALL event__write_Field1d 51 60 52 61 CASE (event_id_write_Field2d) … … 67 76 END SUBROUTINE Process_event 68 77 78 SUBROUTINE event__swap_context 79 IMPLICIT NONE 80 INTEGER :: id_size 81 82 CALL unpack(id_size) 83 CALL sub_internal(id_size) 84 85 CONTAINS 86 87 SUBROUTINE sub_internal(id_size) 88 INTEGER :: id_size 89 CHARACTER(LEN=id_size) :: id 90 91 CALL unpack(id) 92 93 CALL iom__swap_context(id) 94 95 END SUBROUTINE sub_internal 96 97 END SUBROUTINE event__swap_context 98 69 99 70 100 SUBROUTINE event__parse_xml_file … … 172 202 END SUBROUTINE event__set_grid_type_nemo 173 203 204 SUBROUTINE event__set_grid_type_lmdz 205 IMPLICIT NONE 206 INTEGER :: name_size 207 208 CALL unpack(name_size) 209 CALL sub_internal(name_size) 210 211 CONTAINS 212 213 SUBROUTINE sub_internal(name_size) 214 INTEGER :: name_size 215 CHARACTER(LEN=name_size) :: name 216 INTEGER :: nbp 217 INTEGER :: offset 218 219 CALL unpack(name) 220 CALL unpack(nbp) 221 CALL unpack(offset) 222 CALL iom__set_grid_type_lmdz(name,nbp,offset) 223 224 END SUBROUTINE sub_internal 225 226 END SUBROUTINE event__set_grid_type_lmdz 174 227 175 228 SUBROUTINE event__set_vert_axis … … 256 309 257 310 311 SUBROUTINE event__write_field1D 312 IMPLICIT NONE 313 INTEGER :: lenc 314 INTEGER :: dim1 315 316 CALL unpack(lenc) 317 CALL unpack(dim1) 318 CALL sub_internal(lenc,dim1) 319 320 CONTAINS 321 SUBROUTINE sub_internal(lenc,dim1) 322 IMPLICIT NONE 323 INTEGER :: lenc 324 INTEGER :: dim1 325 CHARACTER(len=lenc) :: varname 326 REAL :: var(dim1) 327 328 CALL unpack(varname) 329 CALL unpack_field(var) 330 331 CALL iom__write_Field1d(varname,var) 332 333 END SUBROUTINE sub_internal 334 END SUBROUTINE event__write_field1d 335 258 336 SUBROUTINE event__write_field2D 259 337 IMPLICIT NONE -
XMLIO_SERVER/trunk/src/IOSERVER/mod_ioclient.f90
r8 r26 8 8 USE mod_mpi_buffer_client 9 9 USE mod_wait 10 USE mod_ioserver_namelist 11 USE mod_event_client 12 USE iomanager 13 10 14 IMPLICIT NONE 11 INTEGER, INTENT(OUT) :: NEW_COMM 12 13 CALL Init_parallel 14 CALL Init_mpi_buffer 15 CALL Init_wait 16 17 NEW_COMM=intracomm 15 INTEGER, INTENT(INOUT),OPTIONAL :: NEW_COMM 16 17 INTEGER :: Comm 18 INTEGER :: nb_server 19 INTEGER :: rank 20 INTEGER :: ierr 21 LOGICAL :: init 22 INCLUDE 'mpif.h' 23 24 CALL read_namelist 25 26 IF (using_server) THEN 27 IF (using_oasis) THEN 28 ELSE 29 CALL Init_parallel 30 CALL Init_mpi_buffer 31 CALL Init_wait 32 NEW_COMM=intracomm 33 ENDIF 34 ELSE 35 IF (using_oasis) THEN 36 37 ELSE 38 CALL MPI_INITIALIZED(init,ierr) 39 IF (init) THEN 40 IF (.NOT. PRESENT(NEW_COMM)) THEN 41 Comm=MPI_COMM_WORLD 42 ELSE 43 Comm=New_Comm 44 ENDIF 45 ELSE 46 CALL MPI_INIT(ierr) 47 Comm=MPI_COMM_WORLD 48 49 IF (PRESENT(NEW_COMM)) THEN 50 New_Comm=MPI_COMM_WORLD 51 ENDIF 52 ENDIF 53 CALL MPI_COMM_SIZE(Comm,nb_server,ierr) 54 CALL MPI_COMM_RANK(Comm,rank,ierr) 55 CALL iom__init(1,nb_server,rank) 56 CALL iom__set_current_rank(1) 57 58 ENDIF 59 ENDIF 18 60 19 61 END SUBROUTINE init_ioclient -
XMLIO_SERVER/trunk/src/IOSERVER/mod_iomanager.f90
r17 r26 28 28 END SUBROUTINE iom__parse_xml_file 29 29 30 SUBROUTINE iom__swap_context(id) 31 USE xmlio 32 IMPLICIT NONE 33 CHARACTER(LEN=*) :: id 34 35 IF (current_rank==nb_client) CALL context__swap(id) 36 37 END SUBROUTINE iom__swap_context 38 30 39 SUBROUTINE iom__set_current_rank(rank) 31 40 IMPLICIT NONE … … 99 108 100 109 END SUBROUTINE iom__set_grid_type_nemo 110 111 SUBROUTINE iom__set_grid_type_lmdz(name,nbp,offset) 112 USE xmlio 113 IMPLICIT NONE 114 CHARACTER(LEN=*),INTENT(IN) :: name 115 INTEGER,INTENT(IN) :: nbp 116 INTEGER,INTENT(IN) :: offset 117 118 TYPE(grid), POINTER :: pt_grid 119 TYPE(domain), POINTER :: pt_domain 120 LOGICAL,ALLOCATABLE :: mask(:,:) 121 122 CALL grid__get(name,pt_grid) 123 CALL grid__get_subdomain(pt_grid,current_rank,pt_domain) 124 ALLOCATE(mask(pt_domain%ni,pt_domain%nj)) 125 mask(:,:)=.TRUE. 126 mask(1:offset,1)=.FALSE. 127 mask(MOD(offset+nbp-1,pt_domain%ni)+2:pt_domain%ni,pt_domain%nj)=.FALSE. 128 CALL domain__set_type_box(pt_domain,mask) 129 130 END SUBROUTINE iom__set_grid_type_lmdz 101 131 102 132 SUBROUTINE iom__set_time_parameters(itau0,zjulian,zdt) … … 273 303 nj=local_domain%nj 274 304 275 IF (pt_field%axis%name /="none") THEN305 IF (pt_field%axis%name=="none") THEN 276 306 CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk)) 277 307 ELSE -
XMLIO_SERVER/trunk/src/IOSERVER/server.f90
r17 r26 7 7 USE iomanager 8 8 USE mod_interface_ioipsl 9 USE mod_ioserver_namelist 9 10 IMPLICIT NONE 10 11 INCLUDE 'mpif.h' … … 15 16 ! CALL SLEEP(60) 16 17 PRINT *,'je suis un serveur' 18 CALL read_namelist 17 19 CALL init_parallel 18 20 CALL init_mpi_buffer -
XMLIO_SERVER/trunk/src/XMLIO/create_template
r8 r26 1 sed "s/#TYPE#/field/g" vector_def.template > vector_field_def.inc 2 sed "s/#TYPE#/field/g" vector_contains.template > vector_field_contains.inc 1 #! /bin/bash 3 2 4 sed "s/#TYPE#/field_group/g" vector_def.template > vector_field_group_def.inc 5 sed "s/#TYPE#/field_group/g" vector_contains.template > vector_field_group_contains.inc 3 function template() 4 { 5 echo ${1} 6 sed "s/#TYPE#/${1}/g" vector_def.template > vector_${1}_def.inc 7 sed "s/#TYPE#/${1}/g" vector_contains.template > vector_${1}_contains.inc 8 } 6 9 7 sed "s/#TYPE#/axis/g" vector_def.template > vector_axis_def.inc8 sed "s/#TYPE#/axis/g" vector_contains.template > vector_axis_contains.inc9 10 10 sed "s/#TYPE#/axis_group/g" vector_def.template > vector_axis_group_def.inc 11 sed "s/#TYPE#/axis_group/g" vector_contains.template > vector_axis_group_contains.inc 12 13 sed "s/#TYPE#/node/g" vector_def.template > vector_node_def.inc 14 sed "s/#TYPE#/node/g" vector_contains.template > vector_node_contains.inc 15 16 sed "s/#TYPE#/domain/g" vector_def.template > vector_domain_def.inc 17 sed "s/#TYPE#/domain/g" vector_contains.template > vector_domain_contains.inc 18 19 sed "s/#TYPE#/grid/g" vector_def.template > vector_grid_def.inc 20 sed "s/#TYPE#/grid/g" vector_contains.template > vector_grid_contains.inc 21 22 sed "s/#TYPE#/grid_group/g" vector_def.template > vector_grid_group_def.inc 23 sed "s/#TYPE#/grid_group/g" vector_contains.template > vector_grid_group_contains.inc 24 25 sed "s/#TYPE#/file/g" vector_def.template > vector_file_def.inc 26 sed "s/#TYPE#/file/g" vector_contains.template > vector_file_contains.inc 27 28 sed "s/#TYPE#/file_group/g" vector_def.template > vector_file_group_def.inc 29 sed "s/#TYPE#/file_group/g" vector_contains.template > vector_file_group_contains.inc 30 31 sed "s/#TYPE#/file_dep/g" vector_def.template > vector_file_dep_def.inc 32 sed "s/#TYPE#/file_dep/g" vector_contains.template > vector_file_dep_contains.inc 33 34 sed "s/#TYPE#/field_dep/g" vector_def.template > vector_field_dep_def.inc 35 sed "s/#TYPE#/field_dep/g" vector_contains.template > vector_field_dep_contains.inc 36 37 sed "s/#TYPE#/field_out/g" vector_def.template > vector_field_out_def.inc 38 sed "s/#TYPE#/field_out/g" vector_contains.template > vector_field_out_contains.inc 11 template field 12 template field_group 13 template axis 14 template axis_group 15 template node 16 template domain 17 template grid 18 template grid_group 19 template file 20 template file_group 21 template field_dep 22 template file_dep 23 template field_out 24 template context -
XMLIO_SERVER/trunk/src/XMLIO/mod_axis.f90
r8 r26 31 31 INCLUDE 'vector_axis_contains.inc' 32 32 33 SUBROUTINE axis__swap_context(saved_axis_Ids,saved_Ids) 34 IMPLICIT NONE 35 TYPE(vector_axis),POINTER :: saved_axis_Ids 36 TYPE(sorted_list),POINTER :: saved_Ids 37 38 axis_ids=>saved_axis_ids 39 ids=>saved_ids 40 41 END SUBROUTINE axis__swap_context 42 33 43 SUBROUTINE axis__init 34 44 IMPLICIT NONE 35 36 ALLOCATE(axis_Ids)37 ALLOCATE(Ids)38 45 39 46 CALL vector_axis__new(axis_Ids) -
XMLIO_SERVER/trunk/src/XMLIO/mod_axis_definition.f90
r8 r26 6 6 CONTAINS 7 7 8 SUBROUTINE axis_definition__swap_context(saved_axis_definition) 9 IMPLICIT NONE 10 TYPE(axis_group),POINTER :: saved_axis_definition 11 12 axis_definition=>saved_axis_definition 13 14 END SUBROUTINE axis_definition__swap_context 15 8 16 SUBROUTINE axis_definition__Init 9 17 USE mod_axis_group 10 18 IMPLICIT NONE 11 19 12 ALLOCATE(axis_definition)13 20 CALL axis_group__new(axis_definition,"axis_definition") 14 21 -
XMLIO_SERVER/trunk/src/XMLIO/mod_axis_group.f90
r17 r26 22 22 INCLUDE "vector_axis_group_contains.inc" 23 23 24 SUBROUTINE axis_group__swap_context(saved_axis_group_Ids,saved_ids) 25 IMPLICIT NONE 26 TYPE(vector_axis_group),POINTER :: saved_axis_group_Ids 27 TYPE(sorted_list),POINTER :: saved_Ids 28 29 axis_group_ids=>saved_axis_group_ids 30 ids=>saved_ids 31 32 END SUBROUTINE axis_group__swap_context 33 24 34 SUBROUTINE axis_group__init 25 35 IMPLICIT NONE 26 27 ALLOCATE(axis_group_Ids)28 ALLOCATE(Ids)29 36 30 37 CALL vector_axis_group__new(axis_group_Ids) -
XMLIO_SERVER/trunk/src/XMLIO/mod_dependency.f90
r17 r26 32 32 INCLUDE 'vector_field_out_def.inc' 33 33 34 TYPE(vector_file_dep),POINTER :: file_enabled35 TYPE(vector_field_out),POINTER :: field_enabled36 TYPE(vector_field_dep),POINTER :: field_id34 TYPE(vector_file_dep),POINTER,SAVE :: file_enabled 35 TYPE(vector_field_out),POINTER,SAVE :: field_enabled 36 TYPE(vector_field_dep),POINTER,SAVE :: field_id 37 37 38 38 39 TYPE(sorted_list),POINTER :: sorted_id39 TYPE(sorted_list),POINTER,SAVE :: sorted_id 40 40 41 41 CONTAINS … … 45 45 INCLUDE 'vector_field_out_contains.inc' 46 46 47 48 SUBROUTINE dependency__swap_context(saved_file_enabled,saved_field_enabled,save_field_id,saved_sorted_id) 49 IMPLICIT NONE 50 TYPE(vector_file_dep),POINTER :: saved_file_enabled 51 TYPE(vector_field_out),POINTER :: saved_field_enabled 52 TYPE(vector_field_dep),POINTER :: save_field_id 53 TYPE(sorted_list),POINTER :: saved_sorted_id 54 55 file_enabled=>saved_file_enabled 56 field_enabled=>saved_field_enabled 57 field_id=>save_field_id 58 sorted_id=>saved_sorted_id 59 60 END SUBROUTINE dependency__swap_context 61 47 62 SUBROUTINE set_dependency 48 63 IMPLICIT NONE … … 76 91 Pt_fg=>Pt_file_group 77 92 ELSE 78 ALLOCATE(file_enabled)79 93 CALL vector_file_dep__new(file_enabled) 80 94 Pt_fg=>file_definition … … 161 175 INTEGER :: j 162 176 163 ALLOCATE(field_enabled)164 177 CALL vector_field_out__new(field_enabled) 165 178 … … 189 202 INTEGER :: i 190 203 191 ALLOCATE(field_id)192 204 CALL vector_field_dep__new(field_id) 193 194 ALLOCATE(sorted_id)195 205 CALL sorted_list__new(sorted_id) 196 206 -
XMLIO_SERVER/trunk/src/XMLIO/mod_domain.f90
r8 r26 123 123 ENDIF 124 124 125 pt_domain%nbp=nbp 125 126 ALLOCATE(pt_domain%i_index(nbp)) 126 127 ALLOCATE(pt_domain%j_index(nbp)) 128 ALLOCATE(pt_domain%mask(nbp)) 127 129 128 130 DO i=1,nbp 129 Pt_domain%i_index(i)=(index(i)+offset)/pt_domain%nj+1+pt_domain%ibegin-1 130 Pt_domain%j_index(i)=MOD(index(i)+offset,pt_domain%nj)+1+pt_domain%jbegin-1 131 ! Pt_domain%i_index(i)=(index(i)+offset)/pt_domain%ni+1+pt_domain%ibegin-1 132 ! Pt_domain%j_index(i)=MOD(index(i)+offset,pt_domain%ni)+1+pt_domain%jbegin-1 133 Pt_domain%i_index(i)=MOD(index(i)+offset-1,pt_domain%ni)+1 134 Pt_domain%j_index(i)=(index(i)+offset-1)/pt_domain%ni+1 135 131 136 ENDDO 132 137 -
XMLIO_SERVER/trunk/src/XMLIO/mod_field.f90
r8 r26 47 47 INCLUDE 'vector_field_def.inc' 48 48 49 TYPE(vector_field),POINTER :: field_Ids 50 TYPE(sorted_list),POINTER,PRIVATE :: Ids 49 TYPE(vector_field),POINTER,SAVE :: field_Ids 50 TYPE(sorted_list),POINTER,SAVE,PRIVATE :: Ids 51 51 52 52 53 CONTAINS 53 54 INCLUDE 'vector_field_contains.inc' 54 55 56 SUBROUTINE field__swap_context(saved_field_ids,saved_ids) 57 IMPLICIT NONE 58 TYPE(vector_field),POINTER :: saved_field_ids 59 TYPE(sorted_list),POINTER :: saved_ids 60 61 field_Ids=>saved_field_ids 62 Ids=>saved_Ids 63 64 END SUBROUTINE field__swap_context 65 55 66 SUBROUTINE field__init 56 67 IMPLICIT NONE 57 58 ALLOCATE(field_Ids)59 ALLOCATE(Ids)60 68 61 69 CALL vector_field__new(field_Ids) -
XMLIO_SERVER/trunk/src/XMLIO/mod_field_definition.f90
r8 r26 6 6 CONTAINS 7 7 8 SUBROUTINE field_definition__swap_context(saved_field_definition) 9 IMPLICIT NONE 10 TYPE(field_group),POINTER :: saved_field_definition 11 12 field_definition=>saved_field_definition 13 14 END SUBROUTINE field_definition__swap_context 15 16 8 17 SUBROUTINE field_definition__Init 9 USE mod_field_group10 18 IMPLICIT NONE 11 19 12 ALLOCATE(field_definition) 13 CALL field_group__new(field_definition,"field_definition") 14 20 CALL field_group__new(field_definition,"field_definition") 21 15 22 END SUBROUTINE field_definition__Init 23 16 24 17 25 END MODULE mod_field_definition -
XMLIO_SERVER/trunk/src/XMLIO/mod_field_group.f90
r17 r26 16 16 INCLUDE "vector_field_group_def.inc" 17 17 18 TYPE(vector_field_group), POINTER :: field_group_Ids19 TYPE(sorted_list),POINTER, PRIVATE :: Ids18 TYPE(vector_field_group),SAVE,POINTER :: field_group_Ids 19 TYPE(sorted_list),POINTER,SAVE,PRIVATE :: Ids 20 20 21 21 CONTAINS … … 23 23 INCLUDE "vector_field_group_contains.inc" 24 24 25 26 SUBROUTINE field_group__swap_context(saved_field_group_ids, saved_ids) 27 IMPLICIT NONE 28 TYPE(vector_field_group),POINTER :: saved_field_group_Ids 29 TYPE(sorted_list),POINTER :: saved_Ids 30 31 field_group_ids=>saved_field_group_ids 32 ids=>saved_ids 33 34 END SUBROUTINE field_group__swap_context 35 25 36 SUBROUTINE field_group__init 26 37 IMPLICIT NONE 27 28 ALLOCATE(field_group_Ids)29 ALLOCATE(Ids)30 38 31 39 CALL vector_field_group__new(field_group_Ids) -
XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90
r8 r26 30 30 INCLUDE 'vector_file_contains.inc' 31 31 32 SUBROUTINE file__swap_context(saved_file_ids,saved_ids) 33 IMPLICIT NONE 34 TYPE(vector_file),POINTER :: saved_file_Ids 35 TYPE(sorted_list),POINTER :: saved_Ids 36 37 file_ids=>saved_file_ids 38 ids=>saved_ids 39 40 END SUBROUTINE file__swap_context 41 42 32 43 SUBROUTINE file__init 33 44 IMPLICIT NONE 34 35 ALLOCATE(file_Ids)36 ALLOCATE(Ids)37 45 38 46 CALL vector_file__new(file_Ids) -
XMLIO_SERVER/trunk/src/XMLIO/mod_file_definition.f90
r8 r26 6 6 CONTAINS 7 7 8 SUBROUTINE file_definition__swap_context(saved_file_definition) 9 IMPLICIT NONE 10 TYPE(file_group),POINTER :: saved_file_definition 11 12 file_definition=>saved_file_definition 13 14 END SUBROUTINE file_definition__swap_context 15 8 16 SUBROUTINE file_definition__Init 9 17 USE mod_file_group 10 18 IMPLICIT NONE 11 19 12 ALLOCATE(file_definition)13 20 CALL file_group__new(file_definition,"file_definition") 14 21 -
XMLIO_SERVER/trunk/src/XMLIO/mod_file_group.f90
r17 r26 15 15 INCLUDE "vector_file_group_def.inc" 16 16 17 TYPE(vector_file_group),POINTER :: file_group_Ids18 TYPE(sorted_list),POINTER,PRIVATE :: Ids17 TYPE(vector_file_group),POINTER,SAVE :: file_group_Ids 18 TYPE(sorted_list),POINTER,PRIVATE,SAVE :: Ids 19 19 20 20 CONTAINS … … 22 22 INCLUDE "vector_file_group_contains.inc" 23 23 24 SUBROUTINE file_group__swap_context(saved_file_group_ids,saved_ids) 25 IMPLICIT NONE 26 TYPE(vector_file_group),POINTER :: saved_file_group_Ids 27 TYPE(sorted_list),POINTER :: saved_Ids 28 29 file_group_ids=>saved_file_group_ids 30 ids=>saved_ids 31 32 END SUBROUTINE file_group__swap_context 33 24 34 SUBROUTINE file_group__init 25 35 IMPLICIT NONE 26 27 ALLOCATE(file_group_Ids)28 ALLOCATE(Ids)29 36 30 37 CALL vector_file_group__new(file_group_Ids) -
XMLIO_SERVER/trunk/src/XMLIO/mod_grid.f90
r17 r26 29 29 INCLUDE 'vector_grid_contains.inc' 30 30 31 SUBROUTINE grid__swap_context(saved_grid_Ids,saved_Ids) 32 IMPLICIT NONE 33 TYPE(vector_grid),POINTER :: saved_grid_Ids 34 TYPE(sorted_list),POINTER :: saved_Ids 35 36 grid_ids=>saved_grid_ids 37 ids=>saved_ids 38 END SUBROUTINE grid__swap_context 39 40 31 41 SUBROUTINE grid__init 32 42 IMPLICIT NONE 33 34 ALLOCATE(grid_Ids)35 ALLOCATE(Ids)36 43 37 44 CALL vector_grid__new(grid_Ids) -
XMLIO_SERVER/trunk/src/XMLIO/mod_grid_definition.f90
r8 r26 6 6 CONTAINS 7 7 8 SUBROUTINE grid_definition__swap_context(saved_grid_definition) 9 IMPLICIT NONE 10 TYPE(grid_group),POINTER :: saved_grid_definition 11 12 grid_definition=>saved_grid_definition 13 14 END SUBROUTINE grid_definition__swap_context 15 8 16 SUBROUTINE grid_definition__Init 9 17 USE mod_grid_group 10 18 IMPLICIT NONE 11 19 12 ALLOCATE(grid_definition)13 20 CALL grid_group__new(grid_definition,"grid_definition") 14 21 15 22 END SUBROUTINE grid_definition__Init 16 23 17 24 END MODULE mod_grid_definition -
XMLIO_SERVER/trunk/src/XMLIO/mod_grid_group.f90
r17 r26 15 15 INCLUDE "vector_grid_group_def.inc" 16 16 17 TYPE(vector_grid_group),POINTER :: grid_group_Ids18 TYPE(sorted_list),POINTER, PRIVATE :: Ids17 TYPE(vector_grid_group),POINTER,SAVE :: grid_group_Ids 18 TYPE(sorted_list),POINTER,SAVE,PRIVATE :: Ids 19 19 20 20 CONTAINS … … 22 22 INCLUDE "vector_grid_group_contains.inc" 23 23 24 SUBROUTINE grid_group__swap_context(saved_grid_group_Ids,saved_ids) 25 IMPLICIT NONE 26 TYPE(vector_grid_group),POINTER :: saved_grid_group_Ids 27 TYPE(sorted_list),POINTER :: saved_Ids 28 29 grid_group_ids=>saved_grid_group_ids 30 ids=>saved_ids 31 32 END SUBROUTINE grid_group__swap_context 33 24 34 SUBROUTINE grid_group__init 25 35 IMPLICIT NONE 26 27 ALLOCATE(grid_group_Ids)28 ALLOCATE(Ids)29 36 30 37 CALL vector_grid_group__new(grid_group_Ids) -
XMLIO_SERVER/trunk/src/XMLIO/mod_parse_xml.f90
r17 r26 28 28 CHARACTER(len=100) :: node_name 29 29 30 30 IF (hasChildNodes(root)) THEN 31 31 child_list => getChildnodes(root) 32 32 … … 38 38 39 39 CASE ('simulation') 40 CALL parsing_ definition(child_node)40 CALL parsing_simulation(child_node) 41 41 42 42 CASE DEFAULT … … 45 45 CALL Warning("mod_parse_xml:parsing_root") 46 46 ENDIF 47 END SELECT 48 ENDDO 49 ENDIF 50 51 END SUBROUTINE parsing_root 52 53 SUBROUTINE parsing_simulation(root) 54 IMPLICIT NONE 55 TYPE(fnode), POINTER :: root 56 TYPE(fnode), POINTER :: child_node 57 TYPE(fnodeList), POINTER :: child_list 58 59 INTEGER :: il 60 CHARACTER(len=100) :: node_name 61 62 IF (hasChildNodes(root)) THEN 63 child_list => getChildnodes(root) 64 65 DO il=0,getLength(child_list)-1 66 child_node => item(child_list,il) 67 node_name=getNodename(child_node) 68 69 SELECT CASE (TRIM(node_name)) 70 71 CASE ('context') 72 CALL parsing_context(child_node) 73 74 CASE DEFAULT 75 IF (is_bad_node(node_name)) THEN 76 WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing simulation' 77 CALL Warning("mod_parse_xml:parsing_simulationt") 78 ENDIF 47 79 END SELECT 48 80 … … 50 82 ENDIF 51 83 52 END SUBROUTINE parsing_ root53 54 55 SUBROUTINE parsing_definition(root)84 END SUBROUTINE parsing_simulation 85 86 SUBROUTINE parsing_context(node) 87 USE mod_context 56 88 USE mod_axis_definition 57 89 USE mod_grid_definition 58 90 USE mod_field_definition 59 91 USE mod_file_definition 60 61 IMPLICIT NONE62 TYPE(fnode), POINTER :: root63 TYPE(fnode), POINTER :: child_node92 IMPLICIT NONE 93 TYPE(fnode), POINTER :: node 94 95 TYPE(fnode), POINTER :: child_node 64 96 TYPE(fnodeList), POINTER :: child_list 65 66 INTEGER :: il 67 CHARACTER(len=100) :: node_name 68 69 IF (hasChildNodes(root)) THEN 70 child_list => getChildnodes(root) 97 TYPE(axis),POINTER :: attribute 98 LOGICAL :: is_root 99 INTEGER :: il 100 CHARACTER(len=100) :: node_name 101 CHARACTER(len=100) :: value 102 103 IF (is_attribute_exist(node,"id")) THEN 104 value=getAttribute(node,"id") 105 CALL context__create(TRIM(value)) 106 CALL context__swap(TRIM(value)) 107 ENDIF 108 109 IF (hasChildNodes(node)) THEN 110 child_list => getChildnodes(node) 111 71 112 DO il=0,getLength(child_list)-1 72 113 child_node => item(child_list,il) 73 114 node_name=getNodename(child_node) 74 115 75 116 SELECT CASE (TRIM(node_name)) 76 117 … … 89 130 CASE DEFAULT 90 131 IF (is_bad_node(node_name)) THEN 91 WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing definition'92 CALL Warning("mod_parse_xml:parsing_ definition")132 WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing context' 133 CALL Warning("mod_parse_xml:parsing_context") 93 134 ENDIF 94 END SELECT 95 96 ENDDO 97 ENDIF 98 99 END SUBROUTINE parsing_definition 100 101 102 103 104 105 135 END SELECT 136 ENDDO 137 138 ENDIF 139 140 END SUBROUTINE parsing_context 141 142 106 143 RECURSIVE SUBROUTINE parsing_axis_group(node,parent,root) 107 144 USE mod_axis_definition … … 493 530 494 531 END SUBROUTINE parsing_field_attribute 495 496 497 498 532 499 533 -
XMLIO_SERVER/trunk/src/XMLIO/xmlio.f90
r8 r26 16 16 USE string_function 17 17 USE error_msg 18 USE mod_context 18 19 19 20 CONTAINS … … 24 25 CHARACTER(LEN=*),INTENT(IN) :: xml_file 25 26 26 CALL field__init 27 CALL field_group__Init 28 CALL field_definition__Init 29 30 CALL axis__init 31 CALL axis_group__Init 32 CALL axis_definition__Init 33 34 CALL grid__init 35 CALL grid_group__Init 36 CALL grid_definition__Init 37 38 CALL file__init 39 CALL file_group__Init 40 CALL file_definition__Init 41 27 CALL context__init 42 28 CALL parsing_xml_file(xml_file) 43 29 44 30 END SUBROUTINE xmlio__init 31 45 32 46 33 SUBROUTINE xmlio__close_definition
Note: See TracChangeset
for help on using the changeset viewer.