PROGRAM test_omp USE xios USE mod_wait use omp_lib IMPLICIT NONE INCLUDE "mpif.h" INTEGER :: rank INTEGER :: size INTEGER :: ierr CHARACTER(len=*),PARAMETER :: id="client" INTEGER :: comm TYPE(xios_duration) :: dtime CHARACTER(len=20) :: dtime_str TYPE(xios_date) :: date CHARACTER(len=20) :: date_str CHARACTER(len=15) :: calendar_type TYPE(xios_context) :: ctx_hdl INTEGER,PARAMETER :: ni_glo=100 INTEGER,PARAMETER :: nj_glo=100 INTEGER,PARAMETER :: llm=5 DOUBLE PRECISION :: lval(llm)=1, scalar = 5 TYPE(xios_field) :: field_hdl TYPE(xios_fieldgroup) :: fieldgroup_hdl TYPE(xios_file) :: file_hdl LOGICAL :: ok DOUBLE PRECISION,DIMENSION(ni_glo,nj_glo) :: lon_glo,lat_glo DOUBLE PRECISION :: field_A_glo(ni_glo,nj_glo,llm) DOUBLE PRECISION,ALLOCATABLE :: lon(:,:),lat(:,:),field_A(:,:,:), lonvalue(:,:), axisValue(:), field_domain(:,:) INTEGER :: ni,ibegin,iend,nj,jbegin,jend INTEGER :: i,j,l,ts,n, provided !!! MPI Initialization CALL MPI_INIT_THREAD(3, provided, ierr) if(provided .NE. 3) then print*, "provided thread level = ", provided call MPI_Abort() endif CALL init_wait CALL MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr) CALL MPI_COMM_SIZE(MPI_COMM_WORLD,size,ierr) if(rank < size-2) then !$omp parallel default(firstprivate) CALL xios_initialize(id,return_comm=comm) CALL MPI_COMM_RANK(comm,rank,ierr) CALL MPI_COMM_SIZE(comm,size,ierr) size = size*omp_get_num_threads() rank = rank*omp_get_num_threads() + omp_get_thread_num() DO j=1,nj_glo DO i=1,ni_glo lon_glo(i,j)=(i-1)+(j-1)*ni_glo lat_glo(i,j)=1000+(i-1)+(j-1)*ni_glo DO l=1,llm field_A_glo(i,j,l)=(i-1)+(j-1)*ni_glo*100+10000*l ENDDO ENDDO ENDDO ni=ni_glo ; ibegin=0 jbegin=0 DO n=0,size-1 nj=nj_glo/size IF (n year length = ", xios_get_year_length_in_seconds(date%year) PRINT *, "--> day length = ", xios_get_day_length_in_seconds() CALL xios_date_convert_to_string(date, date_str) PRINT *, "time_origin = ", date_str PRINT *, "xios_date_get_second_of_year(time_origin) = ", xios_date_get_second_of_year(date) PRINT *, "xios_date_get_day_of_year(time_origin) = ", xios_date_get_day_of_year(date) PRINT *, "xios_date_get_fraction_of_year(time_origin) = ", xios_date_get_fraction_of_year(date) PRINT *, "xios_date_get_second_of_day(time_origin) = ", xios_date_get_second_of_day(date) PRINT *, "xios_date_get_fraction_of_day(time_origin) = ", xios_date_get_fraction_of_day(date) dtime%timestep = 1 dtime = 0.5 * dtime CALL xios_duration_convert_to_string(dtime, dtime_str) PRINT *, "duration = ", dtime_str date = date + 3 * (dtime + dtime) CALL xios_date_convert_to_string(date, date_str) PRINT *, "date = time_origin + 3 * (duration + duration) = ", date_str PRINT *, "xios_date_convert_to_seconds(date) = ", xios_date_convert_to_seconds(date) PRINT *, "xios_date_convert_to_seconds(date - 2.5h) = ", xios_date_convert_to_seconds(date - 2.5 * xios_hour) ni=0 ; lonvalue(:,:)=0; CALL xios_get_domain_attr("domain_A",ni=ni,lonvalue_2D=lonvalue) print *,"ni",ni print *,"lonvalue",lonvalue; CALL xios_is_defined_field_attr("field_A",enabled=ok) PRINT *,"field_A : attribute enabled is defined ? ",ok CALL xios_close_context_definition() PRINT*,"field field_A is active ? ",xios_field_is_active("field_A") DO ts=1,4 CALL xios_update_calendar(ts) CALL xios_send_field("field_A",field_A) CALL xios_send_field("field_Axis",axisValue) ! CALL xios_send_field("field_Axis",lval) CALL xios_send_field("field_Domain",field_domain) CALL xios_send_field("field_Scalar",scalar) CALL wait_us(5000) ENDDO CALL xios_context_finalize() !print*, "xios_context_finalize OK", rank, size CALL xios_finalize() print*, "xios finalize OK", rank, size DEALLOCATE(lon, lat, field_A, lonvalue, axisValue, field_domain) !$omp master !call MPI_Barrier(comm) CALL MPI_COMM_FREE(comm, ierr) !$omp end master !$omp barrier !$omp end parallel else CALL xios_init_server print *, "Server : xios_finalize " endif CALL MPI_FINALIZE(ierr) END PROGRAM test_omp