Changes in / [20:30]


Ignore:
Files:
9 added
33 edited

Legend:

Unmodified
Added
Removed

  • /CONFIG/NEMO_XMLIO_SERVER/EXP00/job_server_mercure

    r20 r30  
    1919setenv JOB_REQUEST NEMO 
    2020 
    21 export MPIPROGINF=ALL_DETAIL 
    22 export F_ERRCNT=0 
    23 export F_FMTBUF=0 
    24 export F_SYSLEN=256 
     21setenv MPIPROGINF ALL_DETAIL 
     22setenv F_ERRCNT=0 
     23setenv F_FMTBUF=0 
     24setenv F_SYSLEN=256 
    2525 
    2626cd $PBS_O_WORKDIR  
    2727 
    28 export MPISUSPEND=OFF 
     28setenv MPISUSPEND=OFF 
    2929 
    3030echo "NB_CPU->${NB_CPU}  NB_CPU_SERVER->${NB_CPU_SERVER} NB_CPU_CLIENT->${NB_CPU_CLIENT}" 

  • /XMLF90/arch/arch-SX8_BRODIE.fcm

    r20 r30  
    1111%MPI_FFLAGS 
    1212%OMP_FFLAGS          -P openmp  
    13 %BASE_LD             -size_t64 
     13%BASE_LD              
    1414%MPI_LD 
    1515%OMP_LD              -P openmp 

  • /XMLF90/configure

    r20 r30  
    105105echo "%CPP_KEY       $CPP_KEY"                          >> $config_fcm 
    106106echo "%LD_FFLAGS     $LD_FFLAGS"                        >> $config_fcm 
    107 echo "%INCDIR        -I$NETCDF_INCDIR -I$IOIPSL_INCDIR" >> $config_fcm 
    108 echo "%LIBDIR        -L$NETCDF_LIBDIR -L$IOIPSL_LIBDIR" >> $config_fcm 

  • /XMLIO_SERVER/trunk/arch/arch-IA64_PLATINE.path

    r20 r30  
    66set IOIPSL_LIB="-lioipsl" 
    77 
    8 set XMLF90_INCDIR="-I$PWD/../../lib" 
    9 set XMLF90_LIBDIR="-L$PWD/../../lib" 
     8set XMLF90_INCDIR="-I$PWD/../XMLF90/inc" 
     9set XMLF90_LIBDIR="-L$PWD/../XMLF90/lib" 
    1010set XMLF90_LIB="-lxmlf90" 
    1111 

  • /XMLIO_SERVER/trunk/arch/arch-SX8_BRODIE.fcm

    r20 r30  
    1111%MPI_FFLAGS 
    1212%OMP_FFLAGS          -P openmp  
    13 %BASE_LD             -size_t64 
     13%BASE_LD              
    1414%MPI_LD 
    1515%OMP_LD              -P openmp 

  • /XMLIO_SERVER/trunk/bld.cfg

    r20 r30  
    3939bld::excl_dep        inc::mpif.h 
    4040bld::excl_dep        use::mpi 
     41bld::excl_dep        use::mod_prism_get_comm 
     42bld::excl_dep        use::mod_prism_proto 
    4143 
    4244# Don't generate interface files 

  • /XMLIO_SERVER/trunk/configure

    r20 r30  
    55set default_compile_flags  = "%PROD_FFLAGS" 
    66set has_use_vt             = FALSE 
     7set has_oasis              = FALSE 
    78 
    89top: 
    … …  
    4748        set compile_flags="%DEBUG_FFLAGS" 
    4849        shift ; goto top 
     50 
    4951    case -use_vt 
    5052        set has_use_vt = TRUE 
    5153        shift ; goto top 
    5254         
     55    case -oasis 
     56        set has_oasis = TRUE 
     57        shift ; goto top 
     58    
    5359   default 
    5460        echo "unknown option "$1" , exiting..." 
    … …  
    117123set LIB="$LIB $NETCDF_LIBDIR $NETCDF_LIB" 
    118124 
     125if ( $has_oasis == TRUE ) then 
     126  set INCDIR="$INCDIR $OASIS_INCDIR" 
     127  set LIB="$LIB $OASIS_LIBDIR $OASIS_LIB" 
     128  set CPP_KEY="$CPP_KEY USE_OASIS" 
     129endif 
     130 
    119131if ( $has_use_vt == TRUE ) then 
    120 set INCDIR="$INCDIR $VAMPIR_INCDIR" 
    121 set LIB="$LIB $VAMPIR_LIBDIR $VAMPIR_LIB" 
    122 set CPP_KEY="$CPP_KEY USE_VT" 
     132  set INCDIR="$INCDIR $VAMPIR_INCDIR" 
     133  set LIB="$LIB $VAMPIR_LIBDIR $VAMPIR_LIB" 
     134  set CPP_KEY="$CPP_KEY USE_VT" 
    123135endif 
     136 
    124137 
    125138 

  • /XMLIO_SERVER/trunk/src/IOSERVER/mod_event_client.f90

    r20 r30  
    33  USE mod_mpi_buffer_client, ONLY : create_request, finalize_request 
    44  USE mod_event_parameters  
    5  
    6   LOGICAL, SAVE :: using_server 
     5  USE mod_ioserver_namelist 
    76       
    87CONTAINS 
    98 
     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   
    1026  SUBROUTINE event__parse_xml_file(filename) 
    1127  USE iomanager 
    … …  
    109125  END SUBROUTINE event__set_grid_type_nemo 
    110126   
     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 
    111146   
    112147  SUBROUTINE event__set_time_parameters(itau0,zjulian,zdt) 
    … …  
    162197  END SUBROUTINE event__disable_field 
    163198   
     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 
    164218  SUBROUTINE event__write_field2d(varname,var) 
    165219  USE iomanager 

  • /XMLIO_SERVER/trunk/src/IOSERVER/mod_event_parameters.f90

    r20 r30  
    1313  INTEGER, PARAMETER :: event_id_enable_field          = 111 
    1414  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 
    1518  INTEGER, PARAMETER :: event_id_stop_ioserver         = 999 
    1619END MODULE mod_event_parameters 

  • /XMLIO_SERVER/trunk/src/IOSERVER/mod_event_server.f90

    r20 r30  
    2020    SELECT CASE (event_id) 
    2121     
     22      CASE (event_id_swap_context) 
     23        CALL event__swap_context 
     24         
    2225      CASE (event_id_parse_xml_file) 
    2326        CALL event__parse_xml_file  
    … …  
    3538        CALL event__set_grid_type_nemo 
    3639 
     40      CASE (event_id_set_grid_type_lmdz) 
     41        CALL event__set_grid_type_lmdz 
     42 
    3743      CASE (event_id_set_time_parameters) 
    3844        CALL event__set_time_parameters 
    … …  
    4955      CASE (event_id_disable_field) 
    5056        CALL event__disable_field 
     57 
     58      CASE (event_id_write_Field1d) 
     59        CALL event__write_Field1d 
    5160 
    5261      CASE (event_id_write_Field2d) 
    … …  
    6776   END SUBROUTINE Process_event 
    6877    
     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   
    6999 
    70100  SUBROUTINE event__parse_xml_file 
    … …  
    172202  END SUBROUTINE event__set_grid_type_nemo    
    173203 
     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    
    174227 
    175228  SUBROUTINE event__set_vert_axis 
    … …  
    256309   
    257310       
     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 
    258336  SUBROUTINE event__write_field2D 
    259337  IMPLICIT NONE 

  • /XMLIO_SERVER/trunk/src/IOSERVER/mod_interface_ioipsl.f90

    r20 r30  
    11MODULE mod_interface_ioipsl 
    22 
    3   INTEGER,SAVE,PRIVATE  :: ini_timestep 
    4   REAL,SAVE,PRIVATE     :: zjulian 
    5   REAL,SAVE,PRIVATE     :: timestep  
    6   INTEGER,SAVE,PRIVATE  :: timestep_nb 
     3  
     4  INTEGER,PARAMETER     :: id_file=1 
     5 
     6 
     7CONTAINS 
     8 
     9  SUBROUTINE init_interface_ioipsl 
     10  USE xmlio 
     11  IMPLICIT NONE 
    712   
    8   INTEGER,PARAMETER     :: id_file=1 
    9  
    10  
    11 CONTAINS 
    12  
    13   SUBROUTINE init_interface_ioipsl 
    14   USE xmlio 
    15   IMPLICIT NONE 
    16    
    1713     
    1814  END SUBROUTINE init_interface_ioipsl 
    … …  
    2016 
    2117  SUBROUTINE set_time_parameters(ini_timestep0,zjulian0,timestep0) 
     18  USE xmlio 
    2219  IMPLICIT NONE 
    2320    INTEGER :: ini_timestep0 
    2421    REAL :: zjulian0, timestep0 
    2522 
    26     timestep=timestep0 
    27     ini_timestep=ini_timestep0 
    28     zjulian=zjulian0 
     23    timestep_value=timestep0 
     24    initial_timestep=ini_timestep0 
     25    initial_date=zjulian0 
    2926 
    3027  END SUBROUTINE set_time_parameters 
    … …  
    4138    TYPE(field),POINTER    :: pt_field 
    4239    TYPE(grid),POINTER     :: pt_grid 
     40    TYPE(zoom),POINTER     :: pt_zoom 
    4341    TYPE(axis),POINTER     :: pt_axis 
    4442    TYPE(domain),POINTER   :: pt_domain 
    … …  
    5149    INTEGER :: ioipsl_domain_id 
    5250    INTEGER :: i,j 
     51    CHARACTER(LEN=20) :: direction 
    5352      
    5453    CALL xmlio__close_definition  
    … …  
    6463      pt_grid=>pt_file_dep%grids%at(1)%pt 
    6564      pt_domain=>pt_grid%domain 
    66       CALL set_ioipsl_domain_id(pt_grid,nb_server,server_rank,ioipsl_domain_id) 
    67       CALL histbeg(TRIM(pt_file%name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat,  & 
    68                     1, pt_domain%ni, 1, pt_domain%nj,ini_timestep, zjulian, timestep,           & 
    69                    ioipsl_hori_id, ioipsl_file_id,domain_id=ioipsl_domain_id)                                               
    70        
    71       DO j=1,pt_file_dep%axis%size 
    72         pt_axis=>pt_file_dep%axis%at(j)%pt 
    73         CALL sorted_list__find(axis_id,hash(Pt_axis%name),ioipsl_axis_id,found) 
    74         IF (.NOT. found) THEN 
    75           IF (TRIM(pt_axis%name) /= "none") THEN 
    76             CALL histvert(ioipsl_file_id, TRIM(pt_axis%name),TRIM(pt_axis%description),    & 
    77                          TRIM(pt_axis%unit), pt_axis%size,pt_axis%values, ioipsl_axis_id) 
    78             CALL sorted_list__add(axis_id,hash(Pt_axis%name),ioipsl_axis_id) 
     65      pt_zoom=>pt_file_dep%zooms%at(1)%pt 
     66!      print *,TRIM(pt_file%name),' ',TRIM(pt_zoom%id) 
     67!      print*,'Global --->',pt_zoom%ni_glo,pt_zoom%nj_glo,pt_zoom%ibegin_glo,pt_zoom%jbegin_glo 
     68!      print*,'Local  --->',pt_zoom%ni_loc,pt_zoom%nj_loc,pt_zoom%ibegin_loc,pt_zoom%jbegin_loc 
     69       
     70      IF (pt_zoom%ni_loc*pt_zoom%nj_loc > 0) THEN 
     71         
     72        IF ( (pt_zoom%ni_loc == pt_zoom%ni_glo) .AND. (pt_zoom%nj_loc == pt_zoom%nj_glo) ) THEN  
     73 
     74          CALL histbeg(TRIM(pt_file%name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat,  & 
     75                     pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,        &                                            & 
     76                     initial_timestep, initial_date, timestep_value,                              & 
     77                     ioipsl_hori_id, ioipsl_file_id) 
     78         ELSE                                               
     79 
     80          CALL set_ioipsl_domain_id(pt_grid,nb_server,server_rank,ioipsl_domain_id) 
     81          CALL histbeg(TRIM(pt_file%name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat,  & 
     82                     pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,        &                                            & 
     83                     initial_timestep, initial_date, timestep_value,                              & 
     84                     ioipsl_hori_id, ioipsl_file_id,domain_id=ioipsl_domain_id)                                               
     85        
     86         ENDIF 
     87         
     88       
     89        DO j=1,pt_file_dep%axis%size 
     90          pt_axis=>pt_file_dep%axis%at(j)%pt 
     91          CALL sorted_list__find(axis_id,hash(Pt_axis%name),ioipsl_axis_id,found) 
     92          IF (.NOT. found) THEN 
     93            IF (TRIM(pt_axis%name) /= "none") THEN 
     94               
     95              IF (pt_axis%has_positive) THEN  
     96                IF (pt_axis%positive) THEN 
     97                  direction="up" 
     98                ELSE 
     99                  direction="down" 
     100                ENDIF 
     101              ELSE 
     102                direction='unknown' 
     103              ENDIF 
     104 
     105              CALL histvert(ioipsl_file_id, TRIM(pt_axis%name),TRIM(pt_axis%description),    & 
     106                           TRIM(pt_axis%unit), pt_axis%size,pt_axis%values, ioipsl_axis_id,  & 
     107                           pdirect=direction) 
     108              CALL sorted_list__add(axis_id,hash(Pt_axis%name),ioipsl_axis_id) 
     109            ENDIF 
    79110          ENDIF 
    80         ENDIF 
    81       ENDDO 
    82        
    83       DO j=1,pt_file_dep%fields%size 
    84         pt_field=>pt_file_dep%fields%at(j)%pt 
    85         IF (pt_field%axis%name=="none") THEN 
    86           pt_field%internal(id_file)=ioipsl_file_id 
    87           CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,            & 
    88                     &  pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,      & 
    89                     &  ioipsl_hori_id, 1, 1, 1, -99, 32, pt_field%operation,                 & 
    90                     &  real(pt_field%freq_op), real(pt_file%output_freq) ) 
    91         ELSE 
    92           pt_field%internal(id_file)=ioipsl_file_id 
    93           CALL sorted_list__find(axis_id,hash(Pt_field%axis%name),ioipsl_axis_id,found) 
    94           CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,          & 
    95                      & pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,    & 
    96                      & ioipsl_hori_id, pt_field%axis%size, 1, pt_field%axis%size,          & 
    97                      & ioipsl_axis_id, 32, pt_field%operation, real(pt_field%freq_op),     & 
    98                      & real(pt_file%output_freq) ) 
    99         ENDIF 
    100       ENDDO 
    101       CALL histend(ioipsl_file_id) 
     111        ENDDO 
     112         
     113        DO j=1,pt_file_dep%fields%size 
     114          pt_field=>pt_file_dep%fields%at(j)%pt 
     115          IF (pt_field%axis%name=="none") THEN 
     116            pt_field%internal(id_file)=ioipsl_file_id 
     117            CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,            & 
     118                      &  pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,      & 
     119                      &  ioipsl_hori_id, 1, 1, 1, -99, 32, pt_field%operation,                 & 
     120                      &  real(pt_field%freq_op), real(pt_file%output_freq) ) 
     121          ELSE 
     122            pt_field%internal(id_file)=ioipsl_file_id 
     123            CALL sorted_list__find(axis_id,hash(Pt_field%axis%name),ioipsl_axis_id,found) 
     124            CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,          & 
     125                       & pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,    & 
     126                       & ioipsl_hori_id, pt_field%axis%size, 1, pt_field%axis%size,          & 
     127                       & ioipsl_axis_id, 32, pt_field%operation, real(pt_field%freq_op),     & 
     128                       & real(pt_file%output_freq) ) 
     129          ENDIF 
     130        ENDDO 
     131        CALL histend(ioipsl_file_id) 
     132      ENDIF 
    102133      CALL sorted_list__delete(axis_id) 
    103134    ENDDO 
    … …  
    131162       DO i=1,pt_field_base%field_out%size 
    132163         pt_field=>pt_field_base%field_out%at(i)%pt%field 
    133          ioipsl_file_id=pt_field%internal(id_file) 
    134          CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_nb, var, size(var), nindex) 
     164         IF ( pt_field%zoom%ni_loc * pt_field%zoom%nj_loc > 0) THEN            
     165           ioipsl_file_id=pt_field%internal(id_file) 
     166           CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_number, var, size(var), nindex) 
     167         ENDIF 
    135168       ENDDO 
    136169     ENDIF 
    … …  
    161194       DO i=1,pt_field_base%field_out%size 
    162195         pt_field=>pt_field_base%field_out%at(i)%pt%field 
    163          ioipsl_file_id=pt_field%internal(id_file) 
    164          CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_nb, var, size(var), nindex) 
     196         IF ( pt_field%zoom%ni_loc * pt_field%zoom%nj_loc > 0) THEN            
     197           ioipsl_file_id=pt_field%internal(id_file) 
     198           CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_number, var, size(var), nindex) 
     199         ENDIF 
    165200       ENDDO 
    166201     ENDIF 
    … …  
    169204 
    170205  SUBROUTINE set_timestep(timestep_nb0) 
     206  USE xmlio 
    171207  IMPLICIT NONE 
    172208    INTEGER,INTENT(IN) :: timestep_nb0 
    173209      
    174     timestep_nb=timestep_nb0 
     210    timestep_number=timestep_nb0 
    175211 
    176212  END SUBROUTINE set_timestep 

  • /XMLIO_SERVER/trunk/src/IOSERVER/mod_ioclient.f90

    r20 r30  
    88  USE mod_mpi_buffer_client 
    99  USE mod_wait 
     10  USE mod_ioserver_namelist 
     11  USE mod_event_client 
     12  USE iomanager 
    1013  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 
     14    INTEGER, INTENT(INOUT),OPTIONAL :: NEW_COMM 
     15 
     16    INTEGER :: Comm 
     17    INTEGER :: nb_server 
     18    INTEGER :: rank 
     19    INTEGER :: ierr 
     20    LOGICAL :: init 
     21    INCLUDE 'mpif.h' 
     22  
     23    CALL read_namelist 
     24 
     25    IF (using_server) THEN 
     26      CALL Init_parallel 
     27      CALL Init_mpi_buffer 
     28      CALL Init_wait 
     29      IF (PRESENT(NEW_COMM)) THEN 
     30        NEW_COMM=intracomm 
     31      ENDIF 
     32    ELSE 
     33      CALL MPI_INITIALIZED(init,ierr) 
     34      IF (init) THEN 
     35        IF (.NOT. PRESENT(NEW_COMM)) THEN 
     36           Comm=MPI_COMM_WORLD 
     37        ELSE 
     38          Comm=New_Comm 
     39        ENDIF 
     40      ELSE 
     41        CALL MPI_INIT(ierr) 
     42        Comm=MPI_COMM_WORLD 
     43         
     44        IF (PRESENT(NEW_COMM)) THEN 
     45          New_Comm=MPI_COMM_WORLD 
     46        ENDIF 
     47      ENDIF   
     48      CALL MPI_COMM_SIZE(Comm,nb_server,ierr)      
     49      CALL MPI_COMM_RANK(Comm,rank,ierr) 
     50      CALL iom__init(1,nb_server,rank) 
     51      CALL iom__set_current_rank(1) 
     52    ENDIF 
    1853     
    1954  END SUBROUTINE init_ioclient 

  • /XMLIO_SERVER/trunk/src/IOSERVER/mod_ioclient_para.f90

    r20 r30  
    1212  SUBROUTINE Init_parallel 
    1313  USE mpitrace 
     14  USE mod_ioserver_namelist 
     15#ifdef USE_OASIS 
     16  USE mod_prism_get_comm   
     17#endif 
    1418  IMPLICIT NONE 
    1519    INCLUDE 'mpif.h' 
    … …  
    2529    INTEGER :: div,remain 
    2630    INTEGER :: group_color 
     31    INTEGER :: Comm_client_server 
     32    CHARACTER(LEN=6) :: oasis_server_id 
    2733     
    28 !    PRINT *, "on rentre dans MPI_INIT" 
    29     CALL MPI_INIT(ierr) 
    30     CALL MPI_COMM_RANK(MPI_COMM_WORLD,global_rank,ierr) 
    31     CALL MPI_COMM_SIZE(MPI_COMM_WORLD,global_size,ierr) 
    32      
    33     PRINT *,"MPI_init Ok, --> mpi_comm_split" 
    34     CALL MPI_COMM_SPLIT(MPI_COMM_WORLD,color_client,global_rank,intracomm,ierr) 
     34    IF (using_oasis) THEN 
     35      oasis_server_id=server_id 
     36      PRINT *,'prism_get_intracomm' 
     37#ifdef USE_OASIS 
     38      CALL prism_get_intracomm(Comm_client_server,oasis_server_id,ierr) 
     39#endif 
     40    ELSE 
     41      CALL MPI_INIT(ierr) 
     42      Comm_client_server=MPI_COMM_WORLD 
     43    ENDIF 
     44 
     45    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr) 
     46    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr) 
     47 
     48    CALL MPI_COMM_SPLIT(Comm_client_server,color_client,global_rank,intracomm,ierr) 
    3549    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr) 
    3650    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr) 
    37     PRINT *,"MPI_mpi_comm_split ok --> intracomm"  
     51 
    3852    nb_server_io=global_size-mpi_size 
    3953    div=mpi_size/nb_server_io 
    … …  
    4559      group_color=(nb_server_io-1)-(mpi_size-1-mpi_rank)/div 
    4660    ENDIF 
    47     PRINT *,'group_color',group_color 
    4861 
    49     CALL MPI_COMM_SPLIT(MPI_COMM_WORLD,group_color,global_rank,iocomm,ierr) 
     62    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr) 
    5063     
    5164    CALL MPI_COMM_SIZE(iocomm,iosize,ierr) 
    5265    CALL MPI_COMM_RANK(iocomm,iorank,ierr) 
    53     PRINT *,"io_size-> ",iosize,"iorank-> ",iorank 
     66 
    5467    ALLOCATE(proc_color(0:iosize-1)) 
    5568    CALL MPI_ALLGATHER(color_client,1,MPI_INTEGER,proc_color,1,MPI_INTEGER,iocomm,ierr) 
    56     print *,"proc_color -> ",proc_color 
    5769     
    5870    DO i=0,iosize-1 

  • /XMLIO_SERVER/trunk/src/IOSERVER/mod_iomanager.f90

    r20 r30  
    2828  END SUBROUTINE iom__parse_xml_file 
    2929    
     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 
    3039  SUBROUTINE iom__set_current_rank(rank) 
    3140  IMPLICIT NONE 
    … …  
    99108 
    100109  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 
    101131       
    102132  SUBROUTINE iom__set_time_parameters(itau0,zjulian,zdt) 
    … …  
    273303      nj=local_domain%nj 
    274304       
    275       IF (pt_field%axis%name/="none") THEN 
     305      IF (pt_field%axis%name=="none") THEN 
    276306        CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk)) 
    277307      ELSE  

  • /XMLIO_SERVER/trunk/src/IOSERVER/mod_ioserver_para.f90

    r20 r30  
    2020  SUBROUTINE Init_parallel 
    2121  USE mpitrace 
     22  USE mod_ioserver_namelist 
     23#ifdef USE_OASIS 
     24  USE mod_prism_get_comm  
     25#endif  
    2226  IMPLICIT NONE 
    2327    INCLUDE 'mpif.h' 
    … …  
    2832    INTEGER :: i 
    2933    INTEGER :: group_color 
    30      
    31     CALL MPI_INIT(ierr) 
    32     CALL MPI_COMM_RANK(MPI_COMM_WORLD,global_rank,ierr) 
    33     CALL MPI_COMM_SIZE(MPI_COMM_WORLD,global_size,ierr) 
    34     
    35     CALL MPI_COMM_SPLIT(MPI_COMM_WORLD,color_server,global_rank,intracomm,ierr) 
     34    INTEGER :: Comm_client_server 
     35    INTEGER :: comp_id 
     36    CHARACTER(LEN=6) :: oasis_server_id, oasis_client_id 
     37 
     38    IF (using_oasis) THEN 
     39       oasis_server_id=server_id 
     40       oasis_client_id=client_id 
     41#ifdef USE_OASIS 
     42       CALL prism_init_comp_proto (comp_id, oasis_server_id, ierr) 
     43       CALL prism_get_intracomm(Comm_client_server,oasis_client_id,ierr) 
     44#endif 
     45    ELSE 
     46      CALL MPI_INIT(ierr) 
     47      Comm_client_server=MPI_COMM_WORLD 
     48    ENDIF 
     49         
     50    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr) 
     51    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr) 
     52        
     53    CALL MPI_COMM_SPLIT(Comm_client_server,color_server,global_rank,intracomm,ierr) 
    3654    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr) 
    3755    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr) 
    … …  
    4058    PRINT *,'group_color',group_color 
    4159 
    42     CALL MPI_COMM_SPLIT(MPI_COMM_WORLD,group_color,global_rank,iocomm,ierr)     
     60    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr)     
    4361     
    4462    CALL MPI_COMM_SIZE(iocomm,iosize,ierr) 
    … …  
    6482   
    6583  SUBROUTINE Finalize_parallel 
     84  USE mod_ioserver_namelist 
     85#ifdef USE_OASIS 
     86  USE mod_prism_proto 
     87#endif 
    6688  IMPLICIT NONE 
    6789    include 'mpif.h' 
    6890    INTEGER :: ierr 
    6991     
    70     CALL MPI_FINALIZE(ierr) 
    71  
     92    IF (using_oasis) THEN 
     93#ifdef USE_OASIS 
     94      CALL prism_terminate_proto(ierr) 
     95#endif 
     96    ELSE 
     97      CALL MPI_FINALIZE(ierr) 
     98    ENDIF 
     99     
    72100  END SUBROUTINE Finalize_parallel 
    73101 

  • /XMLIO_SERVER/trunk/src/IOSERVER/server.f90

    r20 r30  
    77  USE iomanager 
    88  USE mod_interface_ioipsl 
     9  USE mod_ioserver_namelist 
    910  IMPLICIT NONE 
    1011  INCLUDE 'mpif.h' 
    … …  
    1516!  CALL SLEEP(60) 
    1617  PRINT *,'je suis un serveur' 
     18  CALL read_namelist 
    1719  CALL init_parallel 
    1820  CALL init_mpi_buffer 

  • /XMLIO_SERVER/trunk/src/XMLIO/create_template

    r20 r30  
    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 
    32 
    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 
     3function 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} 
    69 
    7 sed "s/#TYPE#/axis/g" vector_def.template > vector_axis_def.inc 
    8 sed "s/#TYPE#/axis/g" vector_contains.template > vector_axis_contains.inc 
    910 
    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 
     11template field 
     12template field_group 
     13template axis 
     14template axis_group 
     15template node 
     16template domain 
     17template grid 
     18template grid_group 
     19template file 
     20template file_group 
     21template field_dep 
     22template file_dep 
     23template field_out 
     24template context 
     25template zoom 

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_axis.f90

    r20 r30  
    1818    CHARACTER(len=str_len)      :: unit 
    1919    LOGICAL                     :: has_unit 
     20    LOGICAL                     :: positive 
     21    LOGICAL                     :: has_positive 
    2022    REAL, DIMENSION(:), POINTER :: values 
    2123    LOGICAL                     :: has_values 
    … …  
    3133  INCLUDE 'vector_axis_contains.inc' 
    3234 
     35  SUBROUTINE axis__swap_context(saved_axis_Ids,saved_Ids) 
     36  IMPLICIT NONE 
     37    TYPE(vector_axis),POINTER          :: saved_axis_Ids 
     38    TYPE(sorted_list),POINTER          :: saved_Ids  
     39     
     40    axis_ids=>saved_axis_ids 
     41    ids=>saved_ids 
     42     
     43  END SUBROUTINE axis__swap_context 
     44 
    3345  SUBROUTINE axis__init 
    3446  IMPLICIT NONE 
    35      
    36     ALLOCATE(axis_Ids) 
    37     ALLOCATE(Ids) 
    3847     
    3948    CALL vector_axis__new(axis_Ids) 
    … …  
    6776   INTEGER                       :: Pos 
    6877    
    69    pt_axis%has_id         = .FALSE. 
     78   pt_axis%has_id          = .FALSE. 
    7079   pt_axis%has_name        = .FALSE. 
    7180   pt_axis%has_size        = .FALSE. 
    … …  
    7382   pt_axis%has_unit        = .FALSE. 
    7483   pt_axis%has_values      = .FALSE. 
    75     
     84   pt_axis%has_positive    = .FALSE.  
     85      
    7686   IF (PRESENT(Id)) THEN 
    7787     Pt_axis%id=TRIM(ADJUSTL(Id)) 
    … …  
    8393 END SUBROUTINE axis__new 
    8494 
    85   SUBROUTINE axis__set(pt_axis, name, description, unit, a_size, values) 
     95  SUBROUTINE axis__set(pt_axis, name, description, unit, a_size, values, positive) 
    8696  IMPLICIT NONE 
    8797    TYPE(axis), POINTER         :: pt_axis 
    … …  
    91101    INTEGER           ,OPTIONAL :: a_size 
    92102    REAL, DIMENSION(:),OPTIONAL :: values 
     103    LOGICAL           ,OPTIONAL :: positive 
    93104 
    94105    IF (PRESENT(name)) THEN 
    … …  
    119130    ENDIF 
    120131 
     132    IF (PRESENT(positive)) then 
     133        pt_axis%positive=positive 
     134        pt_axis%has_positive = .TRUE. 
     135    ENDIF 
     136 
    121137  END SUBROUTINE axis__set 
    122138 
    … …  
    160176    ELSE 
    161177      PRINT *,"values undefined" 
     178    ENDIF 
     179 
     180    IF (pt_axis%has_positive) THEN 
     181      PRINT *,"positive = ",pt_axis%positive 
     182    ELSE 
     183      PRINT *,"positive undefined" 
    162184    ENDIF 
    163185 
    … …  
    217239    ELSE 
    218240        pt_axis_out%has_values=.FALSE. 
     241    ENDIF 
     242 
     243    IF (pt_axis_in%has_positive) THEN 
     244        pt_axis_out%positive=pt_axis_in%positive 
     245        pt_axis_out%has_positive=.TRUE. 
     246    ELSE IF ( pt_axis_default%has_positive ) THEN 
     247        pt_axis_out%positive=pt_axis_default%positive 
     248        pt_axis_out%has_positive=.TRUE. 
     249    ELSE 
     250        pt_axis_out%has_positive=.FALSE. 
    219251    ENDIF 
    220252     

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_axis_definition.f90

    r20 r30  
    66CONTAINS 
    77 
     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 
    816  SUBROUTINE axis_definition__Init 
    917  USE mod_axis_group 
    1018  IMPLICIT NONE 
    1119   
    12     ALLOCATE(axis_definition) 
    1320    CALL axis_group__new(axis_definition,"axis_definition") 
    1421     

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_axis_group.f90

    r20 r30  
    2222  INCLUDE "vector_axis_group_contains.inc" 
    2323 
     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 
    2434  SUBROUTINE axis_group__init 
    2535  IMPLICIT NONE 
    26      
    27     ALLOCATE(axis_group_Ids) 
    28     ALLOCATE(Ids) 
    2936     
    3037    CALL vector_axis_group__new(axis_group_Ids) 

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_dependency.f90

    r20 r30  
    55USE mod_axis 
    66USE mod_sorted_list 
     7USE mod_zoom 
    78 
    89TYPE file_dep 
    … …  
    1112  TYPE(vector_field),POINTER   :: fields 
    1213  TYPE(vector_grid),POINTER    :: grids 
     14  TYPE(vector_zoom),POINTER    :: zooms 
    1315  TYPE(vector_axis),POINTER    :: axis 
    1416END TYPE file_dep 
    … …  
    2628  TYPE(axis),  POINTER  :: axis 
    2729  TYPE(grid),  POINTER  :: grid 
     30  TYPE(zoom),  POINTER  :: zoom 
    2831END TYPE field_out 
    2932 
    … …  
    3235INCLUDE 'vector_field_out_def.inc' 
    3336 
    34 TYPE(vector_file_dep),POINTER      :: file_enabled 
    35 TYPE(vector_field_out),POINTER     :: field_enabled  
    36 TYPE(vector_field_dep),POINTER     :: field_id 
     37TYPE(vector_file_dep),POINTER,SAVE      :: file_enabled 
     38TYPE(vector_field_out),POINTER,SAVE     :: field_enabled  
     39TYPE(vector_field_dep),POINTER,SAVE     :: field_id 
    3740 
    3841  
    39 TYPE(sorted_list),POINTER :: sorted_id 
     42TYPE(sorted_list),POINTER,SAVE :: sorted_id 
    4043 
    4144CONTAINS 
    … …  
    4548INCLUDE 'vector_field_out_contains.inc' 
    4649 
     50   
     51  SUBROUTINE dependency__swap_context(saved_file_enabled,saved_field_enabled,save_field_id,saved_sorted_id)   
     52  IMPLICIT NONE 
     53    TYPE(vector_file_dep),POINTER      :: saved_file_enabled 
     54    TYPE(vector_field_out),POINTER     :: saved_field_enabled  
     55    TYPE(vector_field_dep),POINTER     :: save_field_id 
     56    TYPE(sorted_list),POINTER          :: saved_sorted_id   
     57     
     58    file_enabled=>saved_file_enabled    
     59    field_enabled=>saved_field_enabled 
     60    field_id=>save_field_id 
     61    sorted_id=>saved_sorted_id 
     62       
     63  END SUBROUTINE dependency__swap_context 
     64   
    4765  SUBROUTINE set_dependency 
    4866  IMPLICIT NONE 
    … …  
    6785    TYPE (sorted_list),POINTER         :: sorted_axis 
    6886    TYPE (sorted_list),POINTER         :: sorted_grid 
     87    TYPE (sorted_list),POINTER         :: sorted_zoom 
    6988    INTEGER                            :: i 
    7089    INTEGER                            :: j 
    … …  
    7291    ALLOCATE(sorted_axis) 
    7392    ALLOCATE(sorted_grid) 
     93    ALLOCATE(sorted_zoom) 
    7494     
    7595    IF (PRESENT(Pt_file_group)) THEN 
    7696      Pt_fg=>Pt_file_group 
    7797    ELSE 
    78       ALLOCATE(file_enabled) 
    7998      CALL vector_file_dep__new(file_enabled) 
    8099      Pt_fg=>file_definition 
    … …  
    92111        ALLOCATE(Pt_file_dep%fields) 
    93112        ALLOCATE(Pt_file_dep%grids) 
     113        ALLOCATE(Pt_file_dep%zooms) 
    94114        ALLOCATE(Pt_file_dep%axis) 
    95115        pt_file_dep%file=>pt_file 
    … …  
    97117        CALL vector_field__new(Pt_file_dep%fields) 
    98118        CALL vector_grid__new(Pt_file_dep%grids) 
     119        CALL vector_zoom__new(Pt_file_dep%zooms) 
    99120        CALL vector_axis__new(Pt_file_dep%axis) 
    100121        CALL sorted_list__new(sorted_axis) 
    101122        CALL sorted_list__new(sorted_grid) 
     123        CALL sorted_list__new(sorted_zoom) 
    102124         
    103125        CALL Treat_field_group(pt_file%field_list) 
    … …  
    105127        CALL sorted_list__delete(sorted_axis) 
    106128        CALL sorted_list__delete(sorted_grid) 
     129        CALL sorted_list__delete(sorted_zoom) 
    107130      ENDIF 
    108131    ENDDO 
    … …  
    138161              CALL vector_grid__set_new(pt_file_dep%grids,Pt_field%grid,pos) 
    139162              CALL sorted_list__add(sorted_grid,hash(Pt_field%grid%id),pos) 
     163            ENDIF 
     164          ENDIF 
     165 
     166          IF (Pt_field%has_zoom) THEN 
     167            CALL sorted_list__find(sorted_zoom,hash(Pt_field%zoom%id),pos,found) 
     168            IF (.NOT. found) THEN  
     169              CALL vector_zoom__set_new(pt_file_dep%zooms,Pt_field%zoom,pos) 
     170              CALL sorted_list__add(sorted_zoom,hash(Pt_field%zoom%id),pos) 
    140171            ENDIF 
    141172          ENDIF 
    … …  
    161192  INTEGER                  :: j 
    162193   
    163     ALLOCATE(field_enabled) 
    164194    CALL vector_field_out__new(field_enabled) 
    165195     
    … …  
    172202        pt_field_out%axis=>pt_field_out%field%axis 
    173203        pt_field_out%grid=>pt_field_out%field%grid 
     204        pt_field_out%zoom=>pt_field_out%field%zoom 
    174205      ENDDO 
    175206    ENDDO 
    … …  
    189220  INTEGER :: i 
    190221   
    191     ALLOCATE(field_id) 
    192222    CALL vector_field_dep__new(field_id) 
    193  
    194     ALLOCATE(sorted_id) 
    195223    CALL sorted_list__new(sorted_id) 
    196224     

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_domain.f90

    r20 r30  
    11MODULE mod_domain 
    22   USE mod_xmlio_parameters 
    3  
    43   INTEGER, PARAMETER :: box=1 
    54   INTEGER, PARAMETER :: orange=2 
    … …  
    123122    ENDIF 
    124123 
     124    pt_domain%nbp=nbp 
    125125    ALLOCATE(pt_domain%i_index(nbp)) 
    126126    ALLOCATE(pt_domain%j_index(nbp)) 
     127    ALLOCATE(pt_domain%mask(nbp)) 
    127128         
    128129    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 
     130!      Pt_domain%i_index(i)=(index(i)+offset)/pt_domain%ni+1+pt_domain%ibegin-1 
     131!      Pt_domain%j_index(i)=MOD(index(i)+offset,pt_domain%ni)+1+pt_domain%jbegin-1 
     132      Pt_domain%i_index(i)=MOD(index(i)+offset-1,pt_domain%ni)+1 
     133      Pt_domain%j_index(i)=(index(i)+offset-1)/pt_domain%ni+1 
     134       
    131135    ENDDO 
    132136 

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_field.f90

    r20 r30  
    55  USE mod_axis 
    66  USE mod_grid 
    7      
     7  USE mod_zoom 
     8    
    89  IMPLICIT NONE 
    910 
    … …  
    2526    CHARACTER(len=str_len)         :: grid_ref 
    2627    LOGICAL                        :: has_grid_ref 
     28    CHARACTER(len=str_len)         :: zoom_ref 
     29    LOGICAL                        :: has_zoom_ref 
    2730    INTEGER                        :: level 
    2831    LOGICAL                        :: has_level 
    … …  
    4043    TYPE(grid),POINTER             :: grid 
    4144    LOGICAL                        :: has_grid 
     45    TYPE(zoom),POINTER             :: zoom 
     46    LOGICAL                        :: has_zoom 
    4247    INTEGER                        :: internal(internal_field) 
    4348     
    … …  
    4752  INCLUDE 'vector_field_def.inc' 
    4853   
    49   TYPE(vector_field),POINTER            :: field_Ids 
    50   TYPE(sorted_list),POINTER,PRIVATE     :: Ids  
     54  TYPE(vector_field),POINTER,SAVE            :: field_Ids 
     55  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
     56   
    5157 
    5258CONTAINS 
    5359  INCLUDE 'vector_field_contains.inc' 
    54    
     60 
     61  SUBROUTINE field__swap_context(saved_field_ids,saved_ids) 
     62  IMPLICIT NONE 
     63    TYPE(vector_field),POINTER :: saved_field_ids 
     64    TYPE(sorted_list),POINTER  :: saved_ids 
     65     
     66    field_Ids=>saved_field_ids 
     67    Ids=>saved_Ids 
     68 
     69  END SUBROUTINE field__swap_context 
     70 
    5571  SUBROUTINE field__init 
    5672  IMPLICIT NONE 
    57      
    58     ALLOCATE(field_Ids) 
    59     ALLOCATE(Ids) 
    6073     
    6174    CALL vector_field__new(field_Ids) 
    … …  
    99112   pt_field%has_axis_ref = .FALSE. 
    100113   pt_field%has_grid_ref = .FALSE. 
     114   pt_field%has_zoom_ref = .FALSE. 
    101115   pt_field%has_prec = .FALSE. 
    102116   pt_field%has_level = .FALSE.  
    … …  
    107121   Pt_field%has_axis=.FALSE. 
    108122   Pt_field%has_grid=.FALSE. 
     123   Pt_field%has_zoom=.FALSE. 
    109124       
    110125   IF (PRESENT(Id)) THEN 
    … …  
    118133 
    119134 
    120  SUBROUTINE field__set(p_field, name, ref, description, unit, operation, freq_op, axis_ref, grid_ref, prec, level, enabled) 
     135 SUBROUTINE field__set(p_field, name, ref, description, unit, operation, freq_op, axis_ref, grid_ref, zoom_ref, prec, level, enabled) 
    121136 
    122137    TYPE(field), pointer :: p_field 
    … …  
    129144    CHARACTER(len=*),OPTIONAL :: axis_ref 
    130145    CHARACTER(len=*),OPTIONAL :: grid_ref 
     146    CHARACTER(len=*),OPTIONAL :: zoom_ref 
    131147    INTEGER, OPTIONAL :: prec 
    132148    INTEGER, OPTIONAL :: level 
    … …  
    166182        p_field%has_grid_ref = .TRUE. 
    167183    ENDIF 
     184 
     185    IF (PRESENT(zoom_ref)) THEN 
     186        p_field%zoom_ref=TRIM(ADJUSTL(zoom_ref)) 
     187        p_field%has_zoom_ref = .TRUE. 
     188    ENDIF 
     189 
    168190    IF (PRESENT(prec)) then 
    169191        p_field%prec=prec 
    … …  
    232254    ELSE 
    233255        PRINT *, 'grid_ref undefined ' 
     256    ENDIF 
     257 
     258    IF (pt_field%has_zoom_ref) THEN 
     259        PRINT *, 'zoom_ref : ',TRIM(pt_field%zoom_ref) 
     260    ELSE 
     261        PRINT *, 'zoom_ref undefined ' 
    234262    ENDIF 
    235263     
    … …  
    370398    ELSE 
    371399        pt_field_out%has_grid_ref=.FALSE. 
     400    ENDIF 
     401 
     402    IF (pt_field_in%has_zoom_ref) THEN 
     403        pt_field_out%zoom_ref=pt_field_in%zoom_ref 
     404        pt_field_out%has_zoom_ref=.TRUE. 
     405    ELSE IF ( pt_field_default%has_zoom_ref ) THEN 
     406        pt_field_out%zoom_ref=pt_field_default%zoom_ref 
     407        pt_field_out%has_zoom_ref=.TRUE. 
     408    ELSE 
     409        pt_field_out%has_zoom_ref=.FALSE. 
    372410    ENDIF 
    373411 
    … …  
    518556 END SUBROUTINE field__solve_grid_ref 
    519557    
     558 SUBROUTINE field__solve_zoom_ref(pt_field) 
     559 USE error_msg 
     560 IMPLICIT NONE 
     561   TYPE(field), POINTER :: pt_field 
     562    
     563   IF (.NOT. pt_field%has_zoom_ref) THEN 
     564     IF (pt_field%has_grid_ref) THEN 
     565       pt_field%has_zoom_ref=.TRUE. 
     566       pt_field%zoom_ref=pt_field%grid_ref 
     567     ENDIF 
     568   ENDIF 
     569     
     570   IF (pt_field%has_zoom_ref) THEN 
     571     CALL zoom__get(pt_field%zoom_ref,pt_field%zoom) 
     572     IF (ASSOCIATED(pt_field%zoom)) THEN 
     573       pt_field%has_zoom=.TRUE. 
     574     ELSE 
     575       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   & 
     576                        " has a unknown reference to zoom : id =",pt_field%zoom_ref 
     577       CALL error("mod_field::field__solve_zoom_ref") 
     578     ENDIF 
     579   ENDIF 
     580    
     581 END SUBROUTINE field__solve_zoom_ref 
    520582 
    521583    

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_field_definition.f90

    r20 r30  
    66CONTAINS 
    77 
     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 
    817  SUBROUTINE field_definition__Init 
    9   USE mod_field_group 
    1018  IMPLICIT NONE 
    1119   
    12     ALLOCATE(field_definition) 
    13     CALL field_group__new(field_definition,"field_definition") 
    14      
     20   CALL field_group__new(field_definition,"field_definition") 
     21 
    1522  END SUBROUTINE field_definition__Init 
     23   
    1624         
    1725END MODULE mod_field_definition 

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_field_group.f90

    r20 r30  
    1616  INCLUDE "vector_field_group_def.inc"   
    1717 
    18   TYPE(vector_field_group),POINTER      :: field_group_Ids 
    19   TYPE(sorted_list),POINTER,PRIVATE     :: Ids  
     18  TYPE(vector_field_group),SAVE,POINTER      :: field_group_Ids 
     19  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids  
    2020 
    2121CONTAINS 
    … …  
    2323  INCLUDE "vector_field_group_contains.inc" 
    2424 
     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 
    2536  SUBROUTINE field_group__init 
    2637  IMPLICIT NONE 
    27      
    28     ALLOCATE(field_group_Ids) 
    29     ALLOCATE(Ids) 
    3038     
    3139    CALL vector_field_group__new(field_group_Ids) 
    … …  
    150158    CALL field_group__solve_axis_ref(Pt_fg) 
    151159    CALL field_group__solve_grid_ref(Pt_fg) 
     160    CALL field_group__solve_zoom_ref(Pt_fg) 
    152161 
    153162  END SUBROUTINE  field_group__solve_ref 
    … …  
    200209   
    201210  END SUBROUTINE field_group__solve_grid_ref 
     211 
     212  RECURSIVE SUBROUTINE field_group__solve_zoom_ref(Pt_fg) 
     213  IMPLICIT NONE 
     214    TYPE(field_group),POINTER  :: Pt_fg 
     215      
     216    INTEGER :: i 
     217  
     218    DO i=1,Pt_fg%groups%size 
     219      CALL field_group__solve_zoom_ref(Pt_fg%groups%at(i)%pt) 
     220    ENDDO 
     221        
     222    DO i=1,Pt_fg%fields%size 
     223      CALL field__solve_zoom_ref(Pt_fg%fields%at(i)%pt) 
     224    ENDDO 
     225   
     226  END SUBROUTINE field_group__solve_zoom_ref 
    202227   
    203228  RECURSIVE SUBROUTINE field_group__print(Pt_fg) 

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90

    r20 r30  
    3030  INCLUDE 'vector_file_contains.inc' 
    3131 
     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 
    3243  SUBROUTINE file__init 
    3344  IMPLICIT NONE 
    34      
    35     ALLOCATE(file_Ids) 
    36     ALLOCATE(Ids) 
    3745     
    3846    CALL vector_file__new(file_Ids) 

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_file_definition.f90

    r20 r30  
    66CONTAINS 
    77 
     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 
    816  SUBROUTINE file_definition__Init 
    917  USE mod_file_group 
    1018  IMPLICIT NONE 
    1119   
    12     ALLOCATE(file_definition) 
    1320    CALL file_group__new(file_definition,"file_definition") 
    1421     

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_file_group.f90

    r20 r30  
    1515  INCLUDE "vector_file_group_def.inc"   
    1616 
    17   TYPE(vector_file_group),POINTER       :: file_group_Ids 
    18   TYPE(sorted_list),POINTER,PRIVATE     :: Ids  
     17  TYPE(vector_file_group),POINTER,SAVE       :: file_group_Ids 
     18  TYPE(sorted_list),POINTER,PRIVATE,SAVE     :: Ids  
    1919 
    2020CONTAINS 
    … …  
    2222  INCLUDE "vector_file_group_contains.inc" 
    2323 
     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 
    2434  SUBROUTINE file_group__init 
    2535  IMPLICIT NONE 
    26      
    27     ALLOCATE(file_group_Ids) 
    28     ALLOCATE(Ids) 
    2936     
    3037    CALL vector_file_group__new(file_group_Ids) 

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_grid.f90

    r20 r30  
    33  USE mod_sorted_list 
    44  USE mod_domain 
     5  USE mod_zoom 
     6 
    57  IMPLICIT NONE 
    68 
    … …  
    1921    INTEGER                     :: nj 
    2022    LOGICAL                     :: has_dimension 
     23    TYPE(vector_zoom),POINTER   :: associated_zoom 
     24    TYPE(zoom),POINTER          :: global_zoom 
    2125  END TYPE grid 
    2226 
    … …  
    2933  INCLUDE 'vector_grid_contains.inc' 
    3034 
     35  SUBROUTINE grid__swap_context(saved_grid_Ids,saved_Ids) 
     36  IMPLICIT NONE 
     37    TYPE(vector_grid),POINTER          :: saved_grid_Ids 
     38    TYPE(sorted_list),POINTER          :: saved_Ids  
     39     
     40    grid_ids=>saved_grid_ids 
     41    ids=>saved_ids 
     42  END SUBROUTINE grid__swap_context 
     43   
     44   
    3145  SUBROUTINE grid__init 
    3246  IMPLICIT NONE 
    33      
    34     ALLOCATE(grid_Ids) 
    35     ALLOCATE(Ids) 
    3647     
    3748    CALL vector_grid__new(grid_Ids) 
    … …  
    6879   ALLOCATE(pt_grid%subdomain) 
    6980   ALLOCATE(pt_grid%rank_ids) 
     81   ALLOCATE(pt_grid%associated_zoom) 
     82    
    7083   CALL domain__new(pt_grid%domain) 
    7184   CALL vector_domain__new(pt_grid%subdomain) 
    7285   CALL sorted_list__new(pt_grid%rank_ids) 
     86   CALL vector_zoom__new(pt_grid%associated_zoom) 
    7387    
    7488   pt_grid%has_id          = .FALSE. 
    … …  
    8397     CALL sorted_list__Add(Ids,hash(id),Pos) 
    8498   ENDIF 
     99    
     100   CALL grid__get_new_zoom(pt_grid,pt_grid%global_zoom,id) 
    85101 
    86102 END SUBROUTINE grid__new 
    … …  
    153169    TYPE(grid), POINTER  :: pt_grid 
    154170    TYPE(domain),POINTER :: subdomain 
     171    TYPE(zoom),POINTER :: pt_zoom 
    155172     
    156173    REAL,ALLOCATABLE :: lon(:,:) 
    157174    REAL,ALLOCATABLE :: lat(:,:) 
    158     INTEGER :: ib,ie,jb,je,ni,nj,ibegin,jbegin 
     175    INTEGER :: ib,ie,jb,je,ni,nj,ibegin,jbegin,iend,jend 
    159176    INTEGER :: i 
    160177     
    … …  
    196213       
    197214      CALL domain__set(pt_grid%domain,0,ni,nj,ibegin,jbegin,lon,lat) 
    198  
    199        
     215      iend=ibegin+ni-1 
     216      jend=jbegin+nj-1 
     217       
     218       
     219      pt_grid%global_zoom%ni_glo=pt_grid%ni 
     220      pt_grid%global_zoom%nj_glo=pt_grid%nj 
     221      pt_grid%global_zoom%ibegin_glo=1       
     222      pt_grid%global_zoom%jbegin_glo=1 
     223       
     224      DO i=1,pt_grid%associated_zoom%size 
     225        pt_zoom=>pt_grid%associated_zoom%at(i)%pt 
     226         
     227        ib=MAX(pt_zoom%ibegin_glo-ibegin+1,1) 
     228        ie=MIN(pt_zoom%ibegin_glo+pt_zoom%ni_glo-ibegin,ni) 
     229        pt_zoom%ni_loc=MAX(ie-ib+1,0) 
     230        pt_zoom%ibegin_loc=ib 
     231 
     232        jb=MAX(pt_zoom%jbegin_glo-jbegin+1,1) 
     233        je=MIN(pt_zoom%jbegin_glo+pt_zoom%nj_glo-jbegin,nj) 
     234        pt_zoom%nj_loc=MAX(je-jb+1,0) 
     235        pt_zoom%jbegin_loc=jb 
     236      ENDDO 
     237                  
     238             
    200239      DEALLOCATE(lon) 
    201240      DEALLOCATE(lat) 
    … …  
    204243       
    205244             
    206          
     245  SUBROUTINE grid__get_new_zoom(pt_grid,pt_zoom,zoom_id) 
     246  USE string_function 
     247  IMPLICIT NONE 
     248    TYPE(grid), POINTER                      :: pt_grid 
     249    TYPE(zoom),POINTER                       :: pt_zoom 
     250    CHARACTER(LEN=*),INTENT(IN),OPTIONAL     :: zoom_id 
     251    LOGICAL                                  :: success 
     252     
     253     CALL vector_zoom__get_new(pt_grid%associated_zoom,Pt_zoom) 
     254     CALL zoom__new(Pt_zoom,zoom_id) 
     255     
     256   END SUBROUTINE grid__get_new_zoom 
     257      
    207258  SUBROUTINE grid__print(pt_grid) 
    208259  IMPLICIT NONE 

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_grid_definition.f90

    r20 r30  
    66CONTAINS 
    77 
     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 
    816  SUBROUTINE grid_definition__Init 
    917  USE mod_grid_group 
    1018  IMPLICIT NONE 
    1119   
    12     ALLOCATE(grid_definition) 
    1320    CALL grid_group__new(grid_definition,"grid_definition") 
    1421     
    1522  END SUBROUTINE grid_definition__Init 
    16          
     23  
    1724END MODULE mod_grid_definition 

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_grid_group.f90

    r20 r30  
    1515  INCLUDE "vector_grid_group_def.inc"   
    1616 
    17   TYPE(vector_grid_group),POINTER       :: grid_group_Ids 
    18   TYPE(sorted_list),POINTER,PRIVATE     :: Ids  
     17  TYPE(vector_grid_group),POINTER,SAVE       :: grid_group_Ids 
     18  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids  
    1919 
    2020CONTAINS 
    … …  
    2222  INCLUDE "vector_grid_group_contains.inc" 
    2323 
     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    
    2434  SUBROUTINE grid_group__init 
    2535  IMPLICIT NONE 
    26      
    27     ALLOCATE(grid_group_Ids) 
    28     ALLOCATE(Ids) 
    2936     
    3037    CALL vector_grid_group__new(grid_group_Ids) 

  • /XMLIO_SERVER/trunk/src/XMLIO/mod_parse_xml.f90

    r20 r30  
    2828    CHARACTER(len=100) :: node_name 
    2929      
    30      IF (hasChildNodes(root)) THEN 
     30    IF (hasChildNodes(root)) THEN 
    3131      child_list => getChildnodes(root) 
    3232 
    … …  
    3838           
    3939           CASE ('simulation')  
    40              CALL parsing_definition(child_node) 
     40             CALL parsing_simulation(child_node) 
    4141 
    4242           CASE DEFAULT 
    … …  
    4545               CALL Warning("mod_parse_xml:parsing_root") 
    4646             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 
    4779         END SELECT 
    4880        
    … …  
    5082    ENDIF 
    5183              
    52   END SUBROUTINE parsing_root 
    53  
    54  
    55   SUBROUTINE parsing_definition(root) 
     84  END SUBROUTINE parsing_simulation 
     85 
     86  SUBROUTINE parsing_context(node) 
     87  USE mod_context 
    5688  USE mod_axis_definition 
    5789  USE mod_grid_definition 
    5890  USE mod_field_definition 
    5991  USE mod_file_definition 
    60    
    61   IMPLICIT NONE 
    62     TYPE(fnode), POINTER :: root 
    63     TYPE(fnode), POINTER :: child_node 
     92  IMPLICIT NONE   
     93    TYPE(fnode), POINTER         :: node 
     94     
     95    TYPE(fnode), POINTER     :: child_node 
    6496    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 
    71112      DO il=0,getLength(child_list)-1 
    72113        child_node => item(child_list,il) 
    73114        node_name=getNodename(child_node) 
    74            
     115         
    75116        SELECT CASE (TRIM(node_name))  
    76117           
    … …  
    89130           CASE DEFAULT 
    90131             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") 
    93134             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 
    106143  RECURSIVE SUBROUTINE parsing_axis_group(node,parent,root) 
    107144  USE mod_axis_definition 
    … …  
    218255      CALL axis__set(pt_axis,a_size=string_to_integer(value)) 
    219256    ENDIF 
     257 
     258    IF (is_attribute_exist(node,"positive")) THEN 
     259      value =  getAttribute(node,"positive") 
     260      CALL axis__set(pt_axis,positive=string_to_logical(value)) 
     261    ENDIF 
    220262    
    221263  END SUBROUTINE parsing_axis_attribute  
    … …  
    296338    TYPE(grid_group),POINTER :: parent 
    297339     
    298     TYPE(grid),POINTER :: pt_grid 
    299     TYPE(grid),POINTER       :: attribute 
     340    TYPE(grid),POINTER       :: pt_grid 
     341    TYPE(fnode), POINTER     :: child_node 
     342    TYPE(fnodeList), POINTER :: child_list 
    300343    INTEGER :: il 
    301344    CHARACTER(len=100) :: node_name 
    … …  
    311354       
    312355    CALL parsing_grid_attribute(node,pt_grid) 
     356     
     357 
     358   IF (hasChildNodes(node)) THEN 
     359      child_list => getChildnodes(node) 
     360 
     361      DO il=0,getLength(child_list)-1 
     362        child_node => item(child_list,il) 
     363        node_name=getNodename(child_node) 
     364         
     365        SELECT CASE (TRIM(node_name))  
     366         
     367          CASE ('zoom')  
     368            CALL parsing_zoom(child_node,pt_grid) 
     369              
     370          CASE DEFAULT 
     371            IF (is_bad_node(node_name)) THEN 
     372              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing grid' 
     373              CALL Warning("mod_parse_xml:parsing_grid") 
     374            ENDIF 
     375        END SELECT 
     376      ENDDO 
     377    ENDIF 
    313378   
    314379  END SUBROUTINE parsing_grid 
    315380 
    316    
    317381  SUBROUTINE parsing_grid_attribute(node,pt_grid) 
    318382  USE mod_grid 
    … …  
    335399  END SUBROUTINE parsing_grid_attribute  
    336400 
    337  
    338  
    339  
     401  SUBROUTINE parsing_zoom(node,parent) 
     402  USE mod_zoom 
     403  USE mod_grid  
     404  IMPLICIT NONE   
     405    TYPE(fnode), POINTER     :: node 
     406    TYPE(grid),POINTER       :: parent 
     407     
     408    TYPE(zoom),POINTER       :: pt_zoom 
     409    INTEGER :: il 
     410    CHARACTER(len=100) :: node_name 
     411    CHARACTER(len=100) :: value 
     412   
     413       
     414    IF (is_attribute_exist(node,"id")) THEN 
     415      value=getAttribute(node,"id") 
     416      CALL grid__get_new_zoom(parent,pt_zoom,TRIM(value)) 
     417    ELSE 
     418      CALL grid__get_new_zoom(parent,pt_zoom) 
     419    ENDIF 
     420       
     421    CALL parsing_zoom_attribute(node,pt_zoom) 
     422     
     423  END SUBROUTINE parsing_zoom 
     424 
     425 
     426  SUBROUTINE parsing_zoom_attribute(node,pt_zoom) 
     427  USE mod_zoom 
     428  IMPLICIT NONE 
     429    TYPE(fnode), POINTER     :: node 
     430    TYPE(zoom),POINTER       :: pt_zoom 
     431 
     432    CHARACTER(len=100) :: value 
     433    
     434    IF (is_attribute_exist(node,"name")) THEN 
     435      value =  getAttribute(node,"name") 
     436      CALL zoom__set(pt_zoom,name=TRIM(value)) 
     437    ENDIF 
     438 
     439    IF (is_attribute_exist(node,"description")) THEN 
     440      value =  getAttribute(node,"description") 
     441      CALL zoom__set(pt_zoom,description=TRIM(value)) 
     442    ENDIF 
     443 
     444    IF (is_attribute_exist(node,"ni")) THEN 
     445      value =  getAttribute(node,"ni") 
     446      CALL zoom__set(pt_zoom,ni_glo=string_to_integer(value)) 
     447    ENDIF 
     448 
     449    IF (is_attribute_exist(node,"nj")) THEN 
     450      value =  getAttribute(node,"nj") 
     451      CALL zoom__set(pt_zoom,nj_glo=string_to_integer(value)) 
     452    ENDIF 
     453 
     454    IF (is_attribute_exist(node,"ibegin")) THEN 
     455      value =  getAttribute(node,"ibegin") 
     456      CALL zoom__set(pt_zoom,ibegin_glo=string_to_integer(value)) 
     457    ENDIF 
     458 
     459    IF (is_attribute_exist(node,"jbegin")) THEN 
     460      value =  getAttribute(node,"jbegin") 
     461      CALL zoom__set(pt_zoom,jbegin_glo=string_to_integer(value)) 
     462    ENDIF 
     463         
     464  END SUBROUTINE parsing_zoom_attribute  
    340465 
    341466 
    … …  
    471596    ENDIF 
    472597 
     598    IF (is_attribute_exist(node,"zoom_ref")) THEN 
     599      value =  getAttribute(node,"zoom_ref") 
     600      CALL field__set(pt_field,zoom_ref=TRIM(value)) 
     601    ENDIF 
     602 
    473603    IF (is_attribute_exist(node,"level")) THEN 
    474604      value =  getAttribute(node,"level") 
    … …  
    493623 
    494624  END SUBROUTINE parsing_field_attribute  
    495    
    496    
    497    
    498625 
    499626 

  • /XMLIO_SERVER/trunk/src/XMLIO/xmlio.f90

    r20 r30  
    1616  USE string_function 
    1717  USE error_msg 
     18  USE mod_context 
     19  USE mod_time_parameters 
    1820   
    1921CONTAINS 
    … …  
    2426    CHARACTER(LEN=*),INTENT(IN) :: xml_file 
    2527     
    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      
     28    CALL context__init 
    4229    CALL parsing_xml_file(xml_file) 
    4330     
    4431  END SUBROUTINE xmlio__init 
     32   
    4533   
    4634  SUBROUTINE xmlio__close_definition 
Note: See TracChangeset for help on using the changeset viewer.