Changeset 3605 for LMDZ6/branches/Ocean_skin/libf/misc/wxios.F90
- Timestamp:
- Nov 21, 2019, 4:43:45 PM (4 years ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/misc/wxios.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
-
LMDZ6/branches/Ocean_skin/libf/misc/wxios.F90
r3165 r3605 15 15 16 16 INTEGER, SAVE :: g_comm 17 CHARACTER(len=100), SAVE :: g_ctx_name 17 CHARACTER(len=100), SAVE :: g_ctx_name ="LMDZ" 18 18 TYPE(xios_context), SAVE :: g_ctx 19 19 !$OMP THREADPRIVATE(g_comm,g_cts_name,g_ctx) … … 136 136 g_ctx_name = xios_ctx_name 137 137 138 ! Si couple alors init fait dans cpl_init139 IF (.not. PRESENT(type_ocean)) THEN140 CALL wxios_context_init()141 ENDIF138 ! ! Si couple alors init fait dans cpl_init 139 ! IF (.not. PRESENT(type_ocean)) THEN 140 ! CALL wxios_context_init() 141 ! ENDIF 142 142 143 143 END SUBROUTINE wxios_init … … 145 145 SUBROUTINE wxios_context_init() 146 146 USE print_control_mod, ONLY : prt_level, lunout 147 !USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY147 USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY 148 148 IMPLICIT NONE 149 149 … … 152 152 !$OMP MASTER 153 153 !Initialisation du contexte: 154 CALL xios_context_initialize(g_ctx_name, g_comm) 154 !!CALL xios_context_initialize(g_ctx_name, g_comm) 155 CALL xios_context_initialize(g_ctx_name, COMM_LMDZ_PHY) 155 156 CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération 156 157 CALL xios_set_current_context(xios_ctx) !Activation … … 165 166 !$OMP END MASTER 166 167 END SUBROUTINE wxios_context_init 168 169 170 SUBROUTINE wxios_set_context() 171 IMPLICIT NONE 172 TYPE(xios_context) :: xios_ctx 173 174 !$OMP MASTER 175 CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération 176 CALL xios_set_current_context(xios_ctx) !Activation 177 !$OMP END MASTER 178 179 END SUBROUTINE wxios_set_context 167 180 168 181 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 203 216 CASE DEFAULT 204 217 abort_message = 'wxios_set_cal: Mauvais choix de calendrier' 205 CALL abort_ gcm('Gcm:Xios',abort_message,1)218 CALL abort_physic('Gcm:Xios',abort_message,1) 206 219 END SELECT 207 220 … … 237 250 ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!! 238 251 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 239 SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo, & 240 ibegin, iend, ii_begin, ii_end, jbegin, jend, & 241 data_ni, data_ibegin, data_iend, & 242 io_lat, io_lon,is_south_pole,mpi_rank) 243 244 245 USE print_control_mod, ONLY : prt_level, lunout 246 IMPLICIT NONE 247 252 SUBROUTINE wxios_domain_param(dom_id) 253 USE dimphy, only: klon 254 USE mod_phys_lmdz_transfert_para, ONLY: gather, bcast 255 USE mod_phys_lmdz_para, only: jj_nb, jj_begin, jj_end, ii_begin, ii_end, & 256 mpi_size, mpi_rank, klon_mpi, & 257 is_sequential, is_south_pole_dyn 258 USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo 259 USE print_control_mod, ONLY : prt_level, lunout 260 USE geometry_mod 261 262 IMPLICIT NONE 248 263 CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier 249 LOGICAL,INTENT(IN) :: is_sequential ! flag 250 INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes 251 INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes 252 INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes 253 INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes 254 INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain 255 INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain 256 INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row) 257 INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row) 258 INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain 259 INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain 260 INTEGER,INTENT(IN) :: data_ni 261 INTEGER,INTENT(IN) :: data_ibegin 262 INTEGER,INTENT(IN) :: data_iend 263 REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid) 264 REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid) 265 logical,intent(in) :: is_south_pole ! does this process include the south pole? 266 integer,intent(in) :: mpi_rank ! rank of process 267 264 265 REAL :: rlat_glo(klon_glo) 266 REAL :: rlon_glo(klon_glo) 267 REAL :: io_lat(nbp_lat) 268 REAL :: io_lon(nbp_lon) 269 LOGICAL :: mask(nbp_lon,jj_nb) !Masque pour les problèmes de recouvrement MPI 268 270 TYPE(xios_domain) :: dom 271 INTEGER :: i 269 272 LOGICAL :: boool 270 273 271 !Masque pour les problèmes de recouvrement MPI: 272 LOGICAL :: mask(ni,nj) 274 275 276 CALL gather(latitude_deg,rlat_glo) 277 CALL bcast(rlat_glo) 278 CALL gather(longitude_deg,rlon_glo) 279 CALL bcast(rlon_glo) 280 281 !$OMP MASTER 282 io_lat(1)=rlat_glo(1) 283 io_lat(nbp_lat)=rlat_glo(klon_glo) 284 IF ((nbp_lon*nbp_lat) > 1) then 285 DO i=2,nbp_lat-1 286 io_lat(i)=rlat_glo(2+(i-2)*nbp_lon) 287 ENDDO 288 ENDIF 289 290 IF (klon_glo == 1) THEN 291 io_lon(1)=rlon_glo(1) 292 ELSE 293 io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1) 294 ENDIF 295 273 296 274 297 !On récupère le handle: 275 298 CALL xios_get_domain_handle(dom_id, dom) 276 299 277 IF (prt_level >= 10) THEN278 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo279 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend280 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end281 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))282 ENDIF283 284 300 !On parametrise le domaine: 285 CALL xios_set_domain_attr_hdl(dom, ni_glo=ni_glo, ibegin=ibegin-1, ni=ni, type="rectilinear") 286 CALL xios_set_domain_attr_hdl(dom, nj_glo=nj_glo, jbegin=jbegin-1, nj=nj, data_dim=2) 287 CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(ibegin:iend), latvalue_1d=io_lat(jbegin:jend)) 301 CALL xios_set_domain_attr_hdl(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear") 302 CALL xios_set_domain_attr_hdl(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2) 303 CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end)) 304 CALL xios_set_domain_attr("dom_out", domain_ref=dom_id) 305 288 306 !On definit un axe de latitudes pour les moyennes zonales 289 307 IF (xios_is_valid_axis("axis_lat")) THEN 290 CALL xios_set_axis_attr( "axis_lat", n_glo=n j_glo, n=nj, begin=jbegin-1, value=io_lat(jbegin:jend))308 CALL xios_set_axis_attr( "axis_lat", n_glo=nbp_lat, n=jj_nb, begin=jj_begin-1, value=io_lat(jj_begin:jj_end)) 291 309 ENDIF 292 310 … … 294 312 mask(:,:)=.TRUE. 295 313 if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE. 296 if (ii_end<n i) mask(ii_end+1:ni,nj) = .FALSE.314 if (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE. 297 315 ! special case for south pole 298 if ((ii_end .eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.316 if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.true. 299 317 IF (prt_level >= 10) THEN 300 318 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1) 301 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:, nj)=",mask(:,nj)319 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb) 302 320 ENDIF 303 321 CALL xios_set_domain_attr_hdl(dom, mask_2d=mask) … … 311 329 IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id) 312 330 END IF 331 !$OMP END MASTER 332 313 333 END SUBROUTINE wxios_domain_param 314 334 335 336 SUBROUTINE wxios_domain_param_unstructured(dom_id) 337 USE geometry_mod, ONLY : longitude, latitude, boundslon, boundslat,ind_cell_glo 338 USE mod_grid_phy_lmdz, ONLY : nvertex, klon_glo 339 USE mod_phys_lmdz_para 340 USE nrtype, ONLY : PI 341 USE ioipsl_getin_p_mod, ONLY : getin_p 342 IMPLICIT NONE 343 CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier 344 REAL :: lon_mpi(klon_mpi) 345 REAL :: lat_mpi(klon_mpi) 346 REAL :: boundslon_mpi(klon_mpi,nvertex) 347 REAL :: boundslat_mpi(klon_mpi,nvertex) 348 INTEGER :: ind_cell_glo_mpi(klon_mpi) 349 TYPE(xios_domain) :: dom 350 351 LOGICAL :: remap_output 352 353 CALL gather_omp(longitude*180/PI,lon_mpi) 354 CALL gather_omp(latitude*180/PI,lat_mpi) 355 CALL gather_omp(boundslon*180/PI,boundslon_mpi) 356 CALL gather_omp(boundslat*180/PI,boundslat_mpi) 357 CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi) 358 359 remap_output=.TRUE. 360 CALL getin_p("remap_output",remap_output) 361 362 !$OMP MASTER 363 CALL xios_get_domain_handle(dom_id, dom) 364 365 !On parametrise le domaine: 366 CALL xios_set_attr(dom, ni_glo=klon_glo, ibegin=ij_begin-1, ni=ij_nb, type="unstructured") 367 CALL xios_set_attr(dom, nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi, & 368 bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) ) 369 CALL xios_set_attr(dom, i_index=ind_cell_glo_mpi(:)-1) 370 IF (remap_output) THEN 371 CALL xios_set_domain_attr("dom_out", domain_ref="dom_regular") 372 CALL xios_set_fieldgroup_attr("remap_expr", expr="@this_ref") 373 CALL xios_set_fieldgroup_attr("remap_1800s", freq_op=xios_duration_convert_from_string("1800s")) 374 CALL xios_set_fieldgroup_attr("remap_1h", freq_op=xios_duration_convert_from_string("1h")) 375 CALL xios_set_fieldgroup_attr("remap_3h", freq_op=xios_duration_convert_from_string("3h")) 376 CALL xios_set_fieldgroup_attr("remap_6h", freq_op=xios_duration_convert_from_string("6h")) 377 CALL xios_set_fieldgroup_attr("remap_1d", freq_op=xios_duration_convert_from_string("1d")) 378 CALL xios_set_fieldgroup_attr("remap_1mo", freq_op=xios_duration_convert_from_string("1mo")) 379 ENDIF 380 !$OMP END MASTER 381 382 END SUBROUTINE wxios_domain_param_unstructured 383 384 385 386 315 387 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 316 388 ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
Note: See TracChangeset
for help on using the changeset viewer.
