[660] | 1 | PROGRAM test_remap |
---|
| 2 | |
---|
| 3 | USE xios |
---|
| 4 | USE mod_wait |
---|
| 5 | USE netcdf |
---|
| 6 | |
---|
| 7 | IMPLICIT NONE |
---|
| 8 | INCLUDE "mpif.h" |
---|
| 9 | INTEGER :: rank |
---|
| 10 | INTEGER :: size |
---|
| 11 | INTEGER :: ierr |
---|
| 12 | |
---|
| 13 | CHARACTER(len=*),PARAMETER :: id="client" |
---|
| 14 | INTEGER :: comm |
---|
| 15 | TYPE(xios_duration) :: dtime |
---|
| 16 | TYPE(xios_context) :: ctx_hdl |
---|
| 17 | |
---|
| 18 | DOUBLE PRECISION,ALLOCATABLE :: src_lon(:), dst_lon(:) |
---|
| 19 | DOUBLE PRECISION,ALLOCATABLE :: src_lat(:), dst_lat(:) |
---|
| 20 | DOUBLE PRECISION,ALLOCATABLE :: src_boundslon(:,:), dst_boundslon(:,:) |
---|
| 21 | DOUBLE PRECISION,ALLOCATABLE :: src_boundslat(:,:), dst_boundslat(:,:) |
---|
[783] | 22 | DOUBLE PRECISION,ALLOCATABLE :: src_field(:), tmp_field(:), tmp_field_1(:), tmp_field_2(:) |
---|
[660] | 23 | INTEGER :: src_ni_glo, dst_ni_glo; |
---|
| 24 | INTEGER :: src_nvertex, dst_nvertex; |
---|
| 25 | INTEGER :: src_ibegin, dst_ibegin; |
---|
| 26 | INTEGER :: src_ni, dst_ni; |
---|
[775] | 27 | INTEGER :: src_tmp_ni, src_tmp_nj, src_tmp_n; |
---|
[660] | 28 | CHARACTER(LEN=*),PARAMETER :: src_file="h14.nc" |
---|
| 29 | CHARACTER(LEN=*),PARAMETER :: dst_file="r180x90.nc" |
---|
| 30 | INTEGER :: ncid |
---|
| 31 | INTEGER :: dimids(2) |
---|
| 32 | INTEGER :: div,remain |
---|
| 33 | INTEGER :: varid |
---|
| 34 | INTEGER :: ts |
---|
| 35 | INTEGER :: i |
---|
| 36 | |
---|
| 37 | CALL MPI_INIT(ierr) |
---|
| 38 | CALL init_wait |
---|
| 39 | |
---|
| 40 | !!! XIOS Initialization (get the local communicator) |
---|
| 41 | |
---|
| 42 | CALL xios_initialize(id,return_comm=comm) |
---|
| 43 | CALL MPI_COMM_RANK(comm,rank,ierr) |
---|
| 44 | CALL MPI_COMM_SIZE(comm,size,ierr) |
---|
| 45 | |
---|
| 46 | ierr=NF90_OPEN(src_file, NF90_NOWRITE, ncid) |
---|
| 47 | ierr=NF90_INQ_VARID(ncid,"bounds_lon",varid) |
---|
| 48 | ierr=NF90_INQUIRE_VARIABLE(ncid, varid,dimids=dimids) |
---|
| 49 | ierr=NF90_INQUIRE_DIMENSION(ncid, dimids(1), len=src_nvertex) |
---|
| 50 | ierr=NF90_INQUIRE_DIMENSION(ncid, dimids(2), len=src_ni_glo) |
---|
| 51 | |
---|
| 52 | div = src_ni_glo/size |
---|
| 53 | remain = MOD( src_ni_glo, size ) |
---|
| 54 | IF (rank < remain) THEN |
---|
| 55 | src_ni=div+1 ; |
---|
| 56 | src_ibegin=rank*(div+1) ; |
---|
| 57 | ELSE |
---|
| 58 | src_ni=div ; |
---|
| 59 | src_ibegin= remain * (div+1) + (rank-remain) * div ; |
---|
| 60 | ENDIF |
---|
| 61 | |
---|
| 62 | ALLOCATE(src_lon(src_ni)) |
---|
| 63 | ALLOCATE(src_lat(src_ni)) |
---|
| 64 | ALLOCATE(src_boundslon(src_nvertex,src_ni)) |
---|
| 65 | ALLOCATE(src_boundslat(src_nvertex,src_ni)) |
---|
| 66 | ALLOCATE(src_field(src_ni)) |
---|
| 67 | |
---|
| 68 | ierr=NF90_INQ_VARID(ncid,"lon",varid) |
---|
| 69 | ierr=NF90_GET_VAR(ncid,varid, src_lon, start=(/src_ibegin+1/),count=(/src_ni/)) |
---|
| 70 | ierr=NF90_INQ_VARID(ncid,"lat",varid) |
---|
| 71 | ierr=NF90_GET_VAR(ncid,varid, src_lat, start=(/src_ibegin+1/),count=(/src_ni/)) |
---|
| 72 | ierr=NF90_INQ_VARID(ncid,"bounds_lon",varid) |
---|
| 73 | ierr=NF90_GET_VAR(ncid,varid,src_boundslon, start=(/1,src_ibegin+1/),count=(/src_nvertex,src_ni/)) |
---|
| 74 | ierr=NF90_INQ_VARID(ncid,"bounds_lat",varid) |
---|
| 75 | ierr=NF90_GET_VAR(ncid,varid, src_boundslat, start=(/1,src_ibegin+1/),count=(/src_nvertex,src_ni/)) |
---|
| 76 | ierr=NF90_INQ_VARID(ncid,"val",varid) |
---|
| 77 | ierr=NF90_GET_VAR(ncid,varid, src_field, start=(/src_ibegin+1/),count=(/src_ni/)) |
---|
| 78 | |
---|
| 79 | |
---|
| 80 | ierr=NF90_OPEN(dst_file, NF90_NOWRITE, ncid) |
---|
| 81 | ierr=NF90_INQ_VARID(ncid,"bounds_lon",varid) |
---|
| 82 | ierr=NF90_INQUIRE_VARIABLE(ncid, varid,dimids=dimids) |
---|
| 83 | ierr=NF90_INQUIRE_DIMENSION(ncid, dimids(1), len=dst_nvertex) |
---|
| 84 | ierr=NF90_INQUIRE_DIMENSION(ncid, dimids(2), len=dst_ni_glo) |
---|
| 85 | |
---|
| 86 | div = dst_ni_glo/size |
---|
| 87 | remain = MOD( dst_ni_glo, size ) |
---|
| 88 | IF (rank < remain) THEN |
---|
| 89 | dst_ni=div+1 ; |
---|
| 90 | dst_ibegin=rank*(div+1) ; |
---|
| 91 | ELSE |
---|
| 92 | dst_ni=div ; |
---|
| 93 | dst_ibegin= remain * (div+1) + (rank-remain) * div ; |
---|
| 94 | ENDIF |
---|
| 95 | |
---|
| 96 | ALLOCATE(dst_lon(dst_ni)) |
---|
| 97 | ALLOCATE(dst_lat(dst_ni)) |
---|
| 98 | ALLOCATE(dst_boundslon(dst_nvertex,dst_ni)) |
---|
| 99 | ALLOCATE(dst_boundslat(dst_nvertex,dst_ni)) |
---|
| 100 | |
---|
| 101 | ierr=NF90_INQ_VARID(ncid,"lon",varid) |
---|
| 102 | ierr=NF90_GET_VAR(ncid,varid, dst_lon, start=(/dst_ibegin+1/),count=(/dst_ni/)) |
---|
| 103 | ierr=NF90_INQ_VARID(ncid,"lat",varid) |
---|
| 104 | ierr=NF90_GET_VAR(ncid,varid, dst_lat, start=(/dst_ibegin+1/),count=(/dst_ni/)) |
---|
| 105 | ierr=NF90_INQ_VARID(ncid,"bounds_lon",varid) |
---|
| 106 | ierr=NF90_GET_VAR(ncid,varid,dst_boundslon, start=(/1,dst_ibegin+1/),count=(/dst_nvertex,dst_ni/)) |
---|
| 107 | ierr=NF90_INQ_VARID(ncid,"bounds_lat",varid) |
---|
| 108 | ierr=NF90_GET_VAR(ncid,varid, dst_boundslat, start=(/1,dst_ibegin+1/),count=(/dst_nvertex,dst_ni/)) |
---|
| 109 | |
---|
| 110 | CALL xios_context_initialize("test",comm) |
---|
| 111 | CALL xios_get_handle("test",ctx_hdl) |
---|
| 112 | CALL xios_set_current_context(ctx_hdl) |
---|
| 113 | |
---|
[661] | 114 | CALL xios_set_domain_attr("src_domain", ni_glo=src_ni_glo, ibegin=src_ibegin, ni=src_ni, type="unstructured") |
---|
[673] | 115 | CALL xios_set_domain_attr("src_domain", lonvalue_1D=src_lon, latvalue_1D=src_lat, & |
---|
| 116 | bounds_lon_1D=src_boundslon, bounds_lat_1D=src_boundslat, nvertex=src_nvertex) |
---|
| 117 | |
---|
[824] | 118 | CALL xios_set_domain_attr("src_domain_clone", ni_glo=src_ni_glo, ibegin=src_ibegin, ni=src_ni, type="unstructured") |
---|
| 119 | CALL xios_set_domain_attr("src_domain_clone", lonvalue_1D=src_lon, latvalue_1D=src_lat, & |
---|
| 120 | bounds_lon_1D=src_boundslon, bounds_lat_1D=src_boundslat, nvertex=src_nvertex) |
---|
| 121 | |
---|
[689] | 122 | CALL xios_set_domain_attr("dst_domain", ni_glo=dst_ni_glo, ibegin=dst_ibegin, ni=dst_ni, type="unstructured") |
---|
[673] | 123 | CALL xios_set_domain_attr("dst_domain", lonvalue_1D=dst_lon, latvalue_1D=dst_lat, & |
---|
| 124 | bounds_lon_1D=dst_boundslon, bounds_lat_1D=dst_boundslat, nvertex=dst_nvertex) |
---|
| 125 | |
---|
[660] | 126 | dtime%second = 3600 |
---|
| 127 | CALL xios_set_timestep(dtime) |
---|
| 128 | |
---|
| 129 | CALL xios_close_context_definition() |
---|
[775] | 130 | CALL xios_get_domain_attr("src_domain_regular_tmp", ni=src_tmp_ni, nj=src_tmp_nj) |
---|
| 131 | ALLOCATE(tmp_field(src_tmp_ni*src_tmp_nj)) |
---|
[660] | 132 | |
---|
[775] | 133 | CALL xios_get_axis_attr("src_axis_curvilinear", n=src_tmp_n) |
---|
| 134 | CALL xios_get_domain_attr("src_domain_curvilinear", ni=src_tmp_ni, nj=src_tmp_nj) |
---|
| 135 | ALLOCATE(tmp_field_1(src_tmp_ni*src_tmp_nj*src_tmp_n)) |
---|
| 136 | |
---|
[820] | 137 | CALL xios_get_domain_attr("src_domain_unstructured", ni=src_tmp_ni, nj=src_tmp_nj) |
---|
[783] | 138 | ALLOCATE(tmp_field_2(src_tmp_ni*src_tmp_nj)) |
---|
| 139 | |
---|
[660] | 140 | DO ts=1,1 |
---|
[820] | 141 | |
---|
[775] | 142 | CALL xios_recv_field("src_field_regular_tmp", tmp_field) |
---|
| 143 | CALL xios_recv_field("src_field_curvilinear", tmp_field_1) |
---|
[783] | 144 | CALL xios_recv_field("field_src_unstructred", tmp_field_2) |
---|
[660] | 145 | CALL xios_update_calendar(ts) |
---|
[721] | 146 | CALL xios_send_field("src_field",src_field) |
---|
[734] | 147 | CALL xios_send_field("tmp_field",tmp_field) |
---|
[775] | 148 | CALL xios_send_field("tmp_field_1",tmp_field_1) |
---|
[783] | 149 | CALL xios_send_field("tmp_field_2",tmp_field_2) |
---|
[660] | 150 | CALL wait_us(5000) ; |
---|
| 151 | ENDDO |
---|
| 152 | |
---|
| 153 | CALL xios_context_finalize() |
---|
| 154 | |
---|
| 155 | DEALLOCATE(src_lon, src_lat, src_boundslon,src_boundslat, src_field) |
---|
| 156 | DEALLOCATE(dst_lon, dst_lat, dst_boundslon,dst_boundslat) |
---|
[783] | 157 | DEALLOCATE(tmp_field, tmp_field_1, tmp_field_2) |
---|
[660] | 158 | |
---|
| 159 | CALL MPI_COMM_FREE(comm, ierr) |
---|
| 160 | |
---|
| 161 | CALL xios_finalize() |
---|
| 162 | |
---|
| 163 | CALL MPI_FINALIZE(ierr) |
---|
| 164 | |
---|
| 165 | END PROGRAM test_remap |
---|
| 166 | |
---|
| 167 | |
---|
| 168 | |
---|
| 169 | |
---|
| 170 | |
---|