PROGRAM toy_cmip6_omp USE xios USE omp_lib USE mod_wait IMPLICIT NONE INCLUDE "mpif.h" INTEGER,PARAMETER :: il_unit=10 INTEGER :: comm, rank, size_loc, ierr INTEGER :: ni,ibegin,iend,nj,jbegin,jend INTEGER :: i,j,l,ts,n, nb_pt, il_run DOUBLE PRECISION :: sypd, timestep_in_seconds, simulated_seconds_per_seconds, elapsed_per_timestep CHARACTER(len=*),PARAMETER :: id="client" CHARACTER(1000):: duration, timestep INTEGER :: start_year,start_month,start_day TYPE(xios_date) :: cdate, edate TYPE(xios_duration) :: dtime TYPE(xios_context) :: ctx_hdl REAL :: ilon,jlat DOUBLE PRECISION,ALLOCATABLE :: lon_glo(:,:),lat_glo(:,:),lval(:) DOUBLE PRECISION,ALLOCATABLE :: field_A_glo (:,:,:), pressure_glo (:,:,:), height_glo (:,:,:) DOUBLE PRECISION,ALLOCATABLE :: bounds_lon_glo(:,:,:),bounds_lat_glo(:,:,:) DOUBLE PRECISION,ALLOCATABLE :: pressure (:,:,:), height (:,:,:) DOUBLE PRECISION,ALLOCATABLE :: lon(:,:),lat(:,:),lonvalue(:,:) DOUBLE PRECISION,ALLOCATABLE :: bounds_lon(:,:,:),bounds_lat(:,:,:) DOUBLE PRECISION,ALLOCATABLE :: field_atm_2D(:,:),field_atm_3D(:,:,:),field_srf_2D(:),field_srf_3D(:,:) DOUBLE PRECISION,ALLOCATABLE :: field_atm_2D_miss(:,:) DOUBLE PRECISION,ALLOCATABLE :: field_oce_2D(:,:),field_oce_3D(:,:,:) INTEGER, ALLOCATABLE :: kindex(:) INTEGER :: provided INTEGER :: ni_glo, nj_glo,llm NAMELIST /param_toy/ ni_glo, nj_glo,llm,timestep,duration,sypd,start_year,start_month,start_day !!! 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_loc,ierr) if(rank < size_loc-2) then !!! Lecture des parametres du run OPEN(unit=il_unit, file='param.def',status='old',iostat=ierr) READ (il_unit, nml=param_toy) !PRINT *, ni_glo, nj_glo,llm,duration !$omp parallel default(firstprivate) !!! XIOS Initialization (get the local communicator) CALL xios_initialize(id,return_comm=comm) CALL MPI_COMM_RANK(comm,rank,ierr) CALL MPI_COMM_SIZE(comm,size_loc,ierr) rank = rank*omp_get_num_threads() + omp_get_thread_num() size_loc = size_loc*omp_get_num_threads() print*, "rank = ", rank, " size = ", size_loc !!! Initialisation et allocation des coordonnées globales et locales pour la grille régulière ALLOCATE (lon_glo(ni_glo,nj_glo),lat_glo(ni_glo,nj_glo)) ALLOCATE(bounds_lon_glo(4,ni_glo,nj_glo)) ALLOCATE(bounds_lat_glo(4,ni_glo,nj_glo)) ALLOCATE (field_A_glo(ni_glo,nj_glo,llm)) ALLOCATE (pressure_glo(ni_glo,nj_glo,llm)) ALLOCATE (height_glo(ni_glo,nj_glo,llm)) ALLOCATE (lval(llm)) DO j=1,nj_glo DO i=1,ni_glo ilon=i-0.5 jlat=j-0.5 lat_glo(i,j)= 90-(jlat*180./nj_glo) lon_glo(i,j)= (ilon*360./ni_glo) !print*, 'i/lon=',i,'lon=',lon_glo(i,j), 'j/lat=',j,'lat=',lat_glo(i,j) bounds_lat_glo(1,i,j)= 90-((jlat-0.5)*180./nj_glo) bounds_lon_glo(1,i,j)=((ilon-0.5)*360./ni_glo) bounds_lat_glo(2,i,j)= 90-((jlat-0.5)*180./nj_glo) bounds_lon_glo(2,i,j)=((ilon+0.5)*360./ni_glo) bounds_lat_glo(3,i,j)= 90-((jlat+0.5)*180./nj_glo) bounds_lon_glo(3,i,j)=((ilon+0.5)*360./ni_glo) bounds_lat_glo(4,i,j)= 90-((jlat+0.5)*180./nj_glo) bounds_lon_glo(4,i,j)=((ilon-0.5)*360./ni_glo) WHERE (abs(bounds_lat_glo(:,i,j) - 90) < 0.000000001) bounds_lat_glo(:,i,j) = 90 WHERE (abs(bounds_lat_glo(:,i,j) + 90) < 0.000000001) bounds_lat_glo(:,i,j) = -90 DO l=1,llm field_A_glo(i,j,l)=(i-1)+(j-1)*ni_glo+10000*l ! pressure at half levels. First index value is high altitude, low pressure pressure_glo(i,j,l)=((l-0.)/llm)*100000 + (jlat -nj_glo/2.)/nj_glo * 10000 height_glo(i,j,l)=(llm-l+0.5)/llm * 15000 + jlat * 100 ENDDO ENDDO ENDDO ni=ni_glo ; ibegin=0 jbegin=0 DO n=0,size_loc-1 nj=nj_glo/size_loc IF (n