[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(:,:) |
---|
[715] | 22 | DOUBLE PRECISION,ALLOCATABLE :: src_field(:), tmp_field(:) |
---|
[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; |
---|
| 27 | CHARACTER(LEN=*),PARAMETER :: src_file="h14.nc" |
---|
| 28 | CHARACTER(LEN=*),PARAMETER :: dst_file="r180x90.nc" |
---|
| 29 | INTEGER :: ncid |
---|
| 30 | INTEGER :: dimids(2) |
---|
| 31 | INTEGER :: div,remain |
---|
| 32 | INTEGER :: varid |
---|
| 33 | INTEGER :: ts |
---|
| 34 | INTEGER :: i |
---|
| 35 | |
---|
| 36 | CALL MPI_INIT(ierr) |
---|
| 37 | CALL init_wait |
---|
| 38 | |
---|
| 39 | !!! XIOS Initialization (get the local communicator) |
---|
| 40 | |
---|
| 41 | CALL xios_initialize(id,return_comm=comm) |
---|
| 42 | CALL MPI_COMM_RANK(comm,rank,ierr) |
---|
| 43 | CALL MPI_COMM_SIZE(comm,size,ierr) |
---|
| 44 | |
---|
| 45 | ierr=NF90_OPEN(src_file, NF90_NOWRITE, ncid) |
---|
| 46 | ierr=NF90_INQ_VARID(ncid,"bounds_lon",varid) |
---|
| 47 | ierr=NF90_INQUIRE_VARIABLE(ncid, varid,dimids=dimids) |
---|
| 48 | ierr=NF90_INQUIRE_DIMENSION(ncid, dimids(1), len=src_nvertex) |
---|
| 49 | ierr=NF90_INQUIRE_DIMENSION(ncid, dimids(2), len=src_ni_glo) |
---|
| 50 | |
---|
| 51 | div = src_ni_glo/size |
---|
| 52 | remain = MOD( src_ni_glo, size ) |
---|
| 53 | IF (rank < remain) THEN |
---|
| 54 | src_ni=div+1 ; |
---|
| 55 | src_ibegin=rank*(div+1) ; |
---|
| 56 | ELSE |
---|
| 57 | src_ni=div ; |
---|
| 58 | src_ibegin= remain * (div+1) + (rank-remain) * div ; |
---|
| 59 | ENDIF |
---|
| 60 | |
---|
| 61 | ALLOCATE(src_lon(src_ni)) |
---|
| 62 | ALLOCATE(src_lat(src_ni)) |
---|
| 63 | ALLOCATE(src_boundslon(src_nvertex,src_ni)) |
---|
| 64 | ALLOCATE(src_boundslat(src_nvertex,src_ni)) |
---|
| 65 | ALLOCATE(src_field(src_ni)) |
---|
| 66 | |
---|
| 67 | ierr=NF90_INQ_VARID(ncid,"lon",varid) |
---|
| 68 | ierr=NF90_GET_VAR(ncid,varid, src_lon, start=(/src_ibegin+1/),count=(/src_ni/)) |
---|
| 69 | ierr=NF90_INQ_VARID(ncid,"lat",varid) |
---|
| 70 | ierr=NF90_GET_VAR(ncid,varid, src_lat, start=(/src_ibegin+1/),count=(/src_ni/)) |
---|
| 71 | ierr=NF90_INQ_VARID(ncid,"bounds_lon",varid) |
---|
| 72 | ierr=NF90_GET_VAR(ncid,varid,src_boundslon, start=(/1,src_ibegin+1/),count=(/src_nvertex,src_ni/)) |
---|
| 73 | ierr=NF90_INQ_VARID(ncid,"bounds_lat",varid) |
---|
| 74 | ierr=NF90_GET_VAR(ncid,varid, src_boundslat, start=(/1,src_ibegin+1/),count=(/src_nvertex,src_ni/)) |
---|
| 75 | ierr=NF90_INQ_VARID(ncid,"val",varid) |
---|
| 76 | ierr=NF90_GET_VAR(ncid,varid, src_field, start=(/src_ibegin+1/),count=(/src_ni/)) |
---|
| 77 | |
---|
| 78 | |
---|
| 79 | ierr=NF90_OPEN(dst_file, NF90_NOWRITE, ncid) |
---|
| 80 | ierr=NF90_INQ_VARID(ncid,"bounds_lon",varid) |
---|
| 81 | ierr=NF90_INQUIRE_VARIABLE(ncid, varid,dimids=dimids) |
---|
| 82 | ierr=NF90_INQUIRE_DIMENSION(ncid, dimids(1), len=dst_nvertex) |
---|
| 83 | ierr=NF90_INQUIRE_DIMENSION(ncid, dimids(2), len=dst_ni_glo) |
---|
| 84 | |
---|
| 85 | div = dst_ni_glo/size |
---|
| 86 | remain = MOD( dst_ni_glo, size ) |
---|
| 87 | IF (rank < remain) THEN |
---|
| 88 | dst_ni=div+1 ; |
---|
| 89 | dst_ibegin=rank*(div+1) ; |
---|
| 90 | ELSE |
---|
| 91 | dst_ni=div ; |
---|
| 92 | dst_ibegin= remain * (div+1) + (rank-remain) * div ; |
---|
| 93 | ENDIF |
---|
| 94 | |
---|
| 95 | ALLOCATE(dst_lon(dst_ni)) |
---|
| 96 | ALLOCATE(dst_lat(dst_ni)) |
---|
| 97 | ALLOCATE(dst_boundslon(dst_nvertex,dst_ni)) |
---|
| 98 | ALLOCATE(dst_boundslat(dst_nvertex,dst_ni)) |
---|
| 99 | |
---|
| 100 | ierr=NF90_INQ_VARID(ncid,"lon",varid) |
---|
| 101 | ierr=NF90_GET_VAR(ncid,varid, dst_lon, start=(/dst_ibegin+1/),count=(/dst_ni/)) |
---|
| 102 | ierr=NF90_INQ_VARID(ncid,"lat",varid) |
---|
| 103 | ierr=NF90_GET_VAR(ncid,varid, dst_lat, start=(/dst_ibegin+1/),count=(/dst_ni/)) |
---|
| 104 | ierr=NF90_INQ_VARID(ncid,"bounds_lon",varid) |
---|
| 105 | ierr=NF90_GET_VAR(ncid,varid,dst_boundslon, start=(/1,dst_ibegin+1/),count=(/dst_nvertex,dst_ni/)) |
---|
| 106 | ierr=NF90_INQ_VARID(ncid,"bounds_lat",varid) |
---|
| 107 | ierr=NF90_GET_VAR(ncid,varid, dst_boundslat, start=(/1,dst_ibegin+1/),count=(/dst_nvertex,dst_ni/)) |
---|
| 108 | |
---|
| 109 | CALL xios_context_initialize("test",comm) |
---|
| 110 | CALL xios_get_handle("test",ctx_hdl) |
---|
| 111 | CALL xios_set_current_context(ctx_hdl) |
---|
| 112 | |
---|
[661] | 113 | CALL xios_set_domain_attr("src_domain", ni_glo=src_ni_glo, ibegin=src_ibegin, ni=src_ni, type="unstructured") |
---|
[673] | 114 | CALL xios_set_domain_attr("src_domain", lonvalue_1D=src_lon, latvalue_1D=src_lat, & |
---|
| 115 | bounds_lon_1D=src_boundslon, bounds_lat_1D=src_boundslat, nvertex=src_nvertex) |
---|
| 116 | |
---|
[689] | 117 | CALL xios_set_domain_attr("dst_domain", ni_glo=dst_ni_glo, ibegin=dst_ibegin, ni=dst_ni, type="unstructured") |
---|
[673] | 118 | CALL xios_set_domain_attr("dst_domain", lonvalue_1D=dst_lon, latvalue_1D=dst_lat, & |
---|
| 119 | bounds_lon_1D=dst_boundslon, bounds_lat_1D=dst_boundslat, nvertex=dst_nvertex) |
---|
| 120 | |
---|
[715] | 121 | ! CALL xios_set_domain_attr("dst_domain_regular", type="rectilinear") |
---|
[688] | 122 | |
---|
[715] | 123 | |
---|
| 124 | ALLOCATE(tmp_field(180*90/2)) |
---|
[660] | 125 | dtime%second = 3600 |
---|
| 126 | CALL xios_set_timestep(dtime) |
---|
| 127 | |
---|
| 128 | CALL xios_close_context_definition() |
---|
| 129 | |
---|
| 130 | DO ts=1,1 |
---|
[734] | 131 | CALL xios_recv_field("src_field_regular", tmp_field) |
---|
[660] | 132 | CALL xios_update_calendar(ts) |
---|
[721] | 133 | CALL xios_send_field("src_field",src_field) |
---|
[734] | 134 | CALL xios_send_field("tmp_field",tmp_field) |
---|
[660] | 135 | CALL wait_us(5000) ; |
---|
| 136 | ENDDO |
---|
| 137 | |
---|
| 138 | CALL xios_context_finalize() |
---|
| 139 | |
---|
| 140 | DEALLOCATE(src_lon, src_lat, src_boundslon,src_boundslat, src_field) |
---|
| 141 | DEALLOCATE(dst_lon, dst_lat, dst_boundslon,dst_boundslat) |
---|
| 142 | |
---|
| 143 | CALL MPI_COMM_FREE(comm, ierr) |
---|
| 144 | |
---|
| 145 | CALL xios_finalize() |
---|
| 146 | |
---|
| 147 | CALL MPI_FINALIZE(ierr) |
---|
| 148 | |
---|
| 149 | END PROGRAM test_remap |
---|
| 150 | |
---|
| 151 | |
---|
| 152 | |
---|
| 153 | |
---|
| 154 | |
---|