- Timestamp:
- 2020-05-19T12:53:16+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_12905_xios_restart/src/OCE/IOM/iom.F90
r12914 r12950 46 46 USE lib_fortran 47 47 USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal 48 USE iom_nf90 49 USE netcdf 48 50 49 51 IMPLICIT NONE … … 65 67 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 66 68 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate 67 PRIVATE iom_set_rst_context, iom_set_rst w_active, iom_set_rstr_active69 PRIVATE iom_set_rst_context, iom_set_rstr_active 68 70 # endif 69 P UBLIC iom_set_rstw_var_active, iom_set_rstw_core, iom_set_rst_vars71 PRIVATE iom_set_rstw_active 70 72 71 73 INTERFACE iom_get … … 261 263 !set names of the fields in restart file IF using XIOS to read data 262 264 CALL iom_set_rst_context(.TRUE.) 263 CALL iom_set_rst_vars(rst_rfields)264 265 !set which fields are to be read from restart file 265 266 CALL iom_set_rstr_active() 266 267 ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 267 !set names of the fields in restart file IF using XIOS to write data 268 CALL iom_set_rst_context(.FALSE.) 269 CALL iom_set_rst_vars(rst_wfields) 270 !set which fields are to be written to a restart file 271 CALL iom_set_rstw_active(fname) 268 CALL iom_set_rstw_file(fname) 272 269 ELSE 273 270 CALL set_xmlatt … … 291 288 END SUBROUTINE iom_init 292 289 293 SUBROUTINE iom_init_closedef 290 SUBROUTINE iom_init_closedef(cdname) 294 291 !!---------------------------------------------------------------------- 295 292 !! *** SUBROUTINE iom_init_closedef *** … … 299 296 !! 300 297 !!---------------------------------------------------------------------- 301 298 CHARACTER(len=*), OPTIONAL, INTENT(IN) :: cdname 302 299 #if defined key_iomput 300 IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 301 !set names of the fields in restart file IF using XIOS to write data 302 CALL iom_set_rst_context(.FALSE.) 303 ENDIF 304 303 305 CALL xios_close_context_definition() 304 CALL xios_update_calendar( 0 ) 306 307 IF(.NOT. (TRIM(cdname) == TRIM(cwxios_context))) CALL xios_update_calendar( 0 ) 308 305 309 #else 306 310 IF( .FALSE. ) WRITE(numout,*) 'iom_init_closedef: should not see this' ! useless statement to avoid compilation warnings … … 308 312 309 313 END SUBROUTINE iom_init_closedef 310 311 SUBROUTINE iom_set_rstw_var_active(field)312 !!---------------------------------------------------------------------313 !! *** SUBROUTINE iom_set_rstw_var_active ***314 !!315 !! ** Purpose : enable variable in restart file when writing with XIOS316 !!---------------------------------------------------------------------317 CHARACTER(len = *), INTENT(IN) :: field318 INTEGER :: i319 LOGICAL :: llis_set320 CHARACTER(LEN=256) :: clinfo ! info character321 322 #if defined key_iomput323 llis_set = .FALSE.324 325 DO i = 1, max_rst_fields326 IF(TRIM(rst_wfields(i)%vname) == field) THEN327 rst_wfields(i)%active = .TRUE.328 llis_set = .TRUE.329 EXIT330 ENDIF331 ENDDO332 !Warn if variable is not in defined in rst_wfields333 IF(.NOT.llis_set) THEN334 WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined'335 CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 )336 ENDIF337 #else338 clinfo = 'iom_set_rstw_var_active: key_iomput is needed to use XIOS restart read/write functionality'339 CALL ctl_stop('STOP', TRIM(clinfo))340 #endif341 342 END SUBROUTINE iom_set_rstw_var_active343 314 344 315 SUBROUTINE iom_set_rstr_active() … … 352 323 !sets enabled = .TRUE. for each field in restart file 353 324 CHARACTER(len=256) :: rst_file 354 355 325 #if defined key_iomput 356 TYPE(xios_field) :: field_hdl 357 TYPE(xios_file) :: file_hdl 358 TYPE(xios_filegroup) :: filegroup_hdl 359 INTEGER :: i 360 CHARACTER(lc) :: clpath 326 INTEGER :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims 327 TYPE(xios_field) :: field_hdl 328 TYPE(xios_file) :: file_hdl 329 TYPE(xios_filegroup) :: filegroup_hdl 330 INTEGER :: dimids(4), jv,i, idim 331 CHARACTER(LEN=lc) :: clpath 332 CHARACTER(LEN=256) :: clinfo ! info character 333 INTEGER, ALLOCATABLE :: indimlens(:) 334 CHARACTER(LEN=nf90_max_name), ALLOCATABLE :: indimnames(:) 335 CHARACTER(LEN=nf90_max_name) :: dimname, varname 336 LOGICAL :: lmeta 337 338 !failed to build with AGRIF 339 ! meta(1:NMETA) = ["nav_lat", & 340 ! "nav_lon", "nav_lev", "time_instant", & 341 ! "time_instant_bounds", "time_counter", & 342 ! "time_counter_bounds", "x", "y", "numcat"] 343 344 meta(1) = "nav_lat" 345 meta(2) = "nav_lon" 346 meta(3) = "nav_lev" 347 meta(4) = "time_instant" 348 meta(5) = "time_instant_bounds" 349 meta(6) = "time_counter" 350 meta(7) = "time_counter_bounds" 351 meta(8) = "x" 352 meta(9) = "y" 353 meta(10) = "numcat" 361 354 362 355 clpath = TRIM(cn_ocerst_indir) … … 367 360 rst_file = TRIM(clpath)//TRIM(Agrif_CFixed())//'_'//TRIM(cn_ocerst_in) 368 361 ENDIF 362 363 clinfo = ' iom_set_rstr_active, file: '//TRIM(rst_file) 364 369 365 !set name of the restart file and enable available fields 370 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ', TRIM(rst_file)371 366 CALL xios_get_handle("file_definition", filegroup_hdl ) 372 367 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') … … 374 369 par_access="collective", enabled=.TRUE., mode="read", & 375 370 output_freq=xios_timestep) 376 !define variables for restart context 377 DO i = 1, max_rst_fields 378 IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN 379 IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 380 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname)) 381 SELECT CASE (TRIM(rst_rfields(i)%grid)) 382 CASE ("grid_N_3D") 383 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 384 domain_ref="grid_N", axis_ref="nav_lev", operation = "instant") 385 CASE ("grid_N") 386 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 387 domain_ref="grid_N", operation = "instant") 388 CASE ("grid_vector") 389 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 390 axis_ref="nav_lev", operation = "instant") 391 CASE ("grid_scalar") 392 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 393 scalar_ref = "grid_scalar", operation = "instant") 394 END SELECT 395 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file) 396 ENDIF 397 ENDIF 398 END DO 371 372 CALL iom_nf90_check( nf90_inquire( iom_file(numror)%nfid, ndims, nvars, natts ), clinfo ) 373 ALLOCATE(indimlens(ndims), indimnames(ndims)) 374 CALL iom_nf90_check( nf90_inquire( iom_file(numror)%nfid, unlimitedDimId = unlimitedDimId ), clinfo ) 375 376 DO idim = 1, ndims 377 CALL iom_nf90_check( nf90_inquire_dimension( iom_file(numror)%nfid, idim, dimname, dimlen ), clinfo ) 378 indimlens(idim) = dimlen 379 indimnames(idim) = dimname 380 ENDDO 381 382 DO jv =1, nvars 383 lmeta = .FALSE. 384 CALL iom_nf90_check( nf90_inquire_variable( iom_file(numror)%nfid, jv, varname, xtype, ndims, dimids, natts ), clinfo ) 385 DO i = 1, NMETA 386 IF(TRIM(varname) == TRIM(meta(i))) THEN 387 lmeta = .TRUE. 388 ENDIF 389 ENDDO 390 IF(.NOT.lmeta) THEN 391 CALL xios_add_child(file_hdl, field_hdl, TRIM(varname)) 392 mdims = ndims 393 394 IF(ANY(dimids(1:ndims) == unlimitedDimId)) THEN 395 mdims = mdims - 1 396 ENDIF 397 398 IF(mdims == 3) THEN 399 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname), & 400 domain_ref="grid_N", axis_ref=TRIM(iom_axis(indimlens(ndims))), & 401 prec = 8, operation = "instant") 402 ELSEIF(mdims == 2) THEN 403 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname), & 404 domain_ref="grid_N", prec = 8, operation = "instant") 405 ELSEIF(mdims == 1) THEN 406 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname), & 407 axis_ref=TRIM(iom_axis(indimlens(ndims))), prec = 8, operation = "instant") 408 ELSEIF(mdims == 0) THEN 409 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname), & 410 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 411 ELSE 412 WRITE(ctmp1,*) 'iom_set_rstr_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 413 CALL ctl_stop( 'iom_set_rstr_active:', ctmp1 ) 414 ENDIF 415 ENDIF 416 ENDDO 417 DEALLOCATE(indimlens, indimnames) 399 418 #endif 400 419 END SUBROUTINE iom_set_rstr_active 401 420 402 SUBROUTINE iom_set_rstw_ core(cdmdl)421 SUBROUTINE iom_set_rstw_file(cdrst_file) 403 422 !!--------------------------------------------------------------------- 404 !! *** SUBROUTINE iom_set_rstw_core***405 !! 406 !! ** Purpose : set variables which are always in restart file423 !! *** SUBROUTINE iom_set_rstw_file *** 424 !! 425 !! ** Purpose : define file name in XIOS context for writing restart 407 426 !!--------------------------------------------------------------------- 408 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS409 CHARACTER(LEN=256) :: clinfo ! info character410 #if defined key_iomput411 IF(cdmdl == "OPA") THEN412 !from restart.F90413 CALL iom_set_rstw_var_active("rdt")414 IF ( .NOT. ln_diurnal_only ) THEN415 CALL iom_set_rstw_var_active('ub' )416 CALL iom_set_rstw_var_active('vb' )417 CALL iom_set_rstw_var_active('tb' )418 CALL iom_set_rstw_var_active('sb' )419 CALL iom_set_rstw_var_active('sshb')420 !421 CALL iom_set_rstw_var_active('un' )422 CALL iom_set_rstw_var_active('vn' )423 CALL iom_set_rstw_var_active('tn' )424 CALL iom_set_rstw_var_active('sn' )425 CALL iom_set_rstw_var_active('sshn')426 CALL iom_set_rstw_var_active('rhop')427 ENDIF428 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst')429 !from trasbc.F90430 CALL iom_set_rstw_var_active('sbc_hc_b')431 CALL iom_set_rstw_var_active('sbc_sc_b')432 ENDIF433 #else434 clinfo = 'iom_set_rstw_core: key_iomput is needed to use XIOS restart read/write functionality'435 CALL ctl_stop('STOP', TRIM(clinfo))436 #endif437 END SUBROUTINE iom_set_rstw_core438 439 SUBROUTINE iom_set_rst_vars(fields)440 !!---------------------------------------------------------------------441 !! *** SUBROUTINE iom_set_rst_vars ***442 !!443 !! ** Purpose : Fill array fields with the information about all444 !! possible variables and corresponding grids definition445 !! for reading/writing restart with XIOS446 !!---------------------------------------------------------------------447 TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields)448 INTEGER :: i449 450 i = 0451 i = i + 1; fields(i)%vname="rdt"; fields(i)%grid="grid_scalar"452 i = i + 1; fields(i)%vname="un"; fields(i)%grid="grid_N_3D"453 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D"454 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D"455 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D"456 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D"457 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D"458 i = i + 1; fields(i)%vname="sn"; fields(i)%grid="grid_N_3D"459 i = i + 1; fields(i)%vname="sb"; fields(i)%grid="grid_N_3D"460 i = i + 1; fields(i)%vname="sshn"; fields(i)%grid="grid_N"461 i = i + 1; fields(i)%vname="sshb"; fields(i)%grid="grid_N"462 i = i + 1; fields(i)%vname="rhop"; fields(i)%grid="grid_N_3D"463 i = i + 1; fields(i)%vname="kt"; fields(i)%grid="grid_scalar"464 i = i + 1; fields(i)%vname="ndastp"; fields(i)%grid="grid_scalar"465 i = i + 1; fields(i)%vname="adatrj"; fields(i)%grid="grid_scalar"466 i = i + 1; fields(i)%vname="utau_b"; fields(i)%grid="grid_N"467 i = i + 1; fields(i)%vname="vtau_b"; fields(i)%grid="grid_N"468 i = i + 1; fields(i)%vname="qns_b"; fields(i)%grid="grid_N"469 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N"470 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N"471 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D"472 i = i + 1; fields(i)%vname="avt_k"; fields(i)%grid="grid_N_3D"473 i = i + 1; fields(i)%vname="avm_k"; fields(i)%grid="grid_N_3D"474 i = i + 1; fields(i)%vname="dissl"; fields(i)%grid="grid_N_3D"475 i = i + 1; fields(i)%vname="sbc_hc_b"; fields(i)%grid="grid_N"476 i = i + 1; fields(i)%vname="sbc_sc_b"; fields(i)%grid="grid_N"477 i = i + 1; fields(i)%vname="qsr_hc_b"; fields(i)%grid="grid_N_3D"478 i = i + 1; fields(i)%vname="fraqsr_1lev"; fields(i)%grid="grid_N"479 i = i + 1; fields(i)%vname="frc_v"; fields(i)%grid="grid_scalar"480 i = i + 1; fields(i)%vname="frc_t"; fields(i)%grid="grid_scalar"481 i = i + 1; fields(i)%vname="frc_s"; fields(i)%grid="grid_scalar"482 i = i + 1; fields(i)%vname="frc_wn_t"; fields(i)%grid="grid_scalar"483 i = i + 1; fields(i)%vname="frc_wn_s"; fields(i)%grid="grid_scalar"484 i = i + 1; fields(i)%vname="ssh_ini"; fields(i)%grid="grid_N"485 i = i + 1; fields(i)%vname="e3t_ini"; fields(i)%grid="grid_N_3D"486 i = i + 1; fields(i)%vname="hc_loc_ini"; fields(i)%grid="grid_N_3D"487 i = i + 1; fields(i)%vname="sc_loc_ini"; fields(i)%grid="grid_N_3D"488 i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N"489 i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N"490 i = i + 1; fields(i)%vname="tilde_e3t_b"; fields(i)%grid="grid_N"491 i = i + 1; fields(i)%vname="tilde_e3t_n"; fields(i)%grid="grid_N"492 i = i + 1; fields(i)%vname="hdiv_lf"; fields(i)%grid="grid_N"493 i = i + 1; fields(i)%vname="ub2_b"; fields(i)%grid="grid_N"494 i = i + 1; fields(i)%vname="vb2_b"; fields(i)%grid="grid_N"495 i = i + 1; fields(i)%vname="sshbb_e"; fields(i)%grid="grid_N"496 i = i + 1; fields(i)%vname="ubb_e"; fields(i)%grid="grid_N"497 i = i + 1; fields(i)%vname="vbb_e"; fields(i)%grid="grid_N"498 i = i + 1; fields(i)%vname="sshb_e"; fields(i)%grid="grid_N"499 i = i + 1; fields(i)%vname="ub_e"; fields(i)%grid="grid_N"500 i = i + 1; fields(i)%vname="vb_e"; fields(i)%grid="grid_N"501 i = i + 1; fields(i)%vname="fwf_isf_b"; fields(i)%grid="grid_N"502 i = i + 1; fields(i)%vname="isf_sc_b"; fields(i)%grid="grid_N"503 i = i + 1; fields(i)%vname="isf_hc_b"; fields(i)%grid="grid_N"504 i = i + 1; fields(i)%vname="ssh_ibb"; fields(i)%grid="grid_N"505 i = i + 1; fields(i)%vname="rnf_b"; fields(i)%grid="grid_N"506 i = i + 1; fields(i)%vname="rnf_hc_b"; fields(i)%grid="grid_N"507 i = i + 1; fields(i)%vname="rnf_sc_b"; fields(i)%grid="grid_N"508 i = i + 1; fields(i)%vname="nn_fsbc"; fields(i)%grid="grid_scalar"509 i = i + 1; fields(i)%vname="ssu_m"; fields(i)%grid="grid_N"510 i = i + 1; fields(i)%vname="ssv_m"; fields(i)%grid="grid_N"511 i = i + 1; fields(i)%vname="sst_m"; fields(i)%grid="grid_N"512 i = i + 1; fields(i)%vname="sss_m"; fields(i)%grid="grid_N"513 i = i + 1; fields(i)%vname="ssh_m"; fields(i)%grid="grid_N"514 i = i + 1; fields(i)%vname="e3t_m"; fields(i)%grid="grid_N"515 i = i + 1; fields(i)%vname="frq_m"; fields(i)%grid="grid_N"516 i = i + 1; fields(i)%vname="avmb"; fields(i)%grid="grid_vector"517 i = i + 1; fields(i)%vname="avtb"; fields(i)%grid="grid_vector"518 i = i + 1; fields(i)%vname="ub2_i_b"; fields(i)%grid="grid_N"519 i = i + 1; fields(i)%vname="vb2_i_b"; fields(i)%grid="grid_N"520 i = i + 1; fields(i)%vname="ntime"; fields(i)%grid="grid_scalar"521 i = i + 1; fields(i)%vname="Dsst"; fields(i)%grid="grid_scalar"522 i = i + 1; fields(i)%vname="tmask"; fields(i)%grid="grid_N_3D"523 i = i + 1; fields(i)%vname="umask"; fields(i)%grid="grid_N_3D"524 i = i + 1; fields(i)%vname="vmask"; fields(i)%grid="grid_N_3D"525 i = i + 1; fields(i)%vname="smask"; fields(i)%grid="grid_N_3D"526 i = i + 1; fields(i)%vname="gdepw_n"; fields(i)%grid="grid_N_3D"527 i = i + 1; fields(i)%vname="e3t_n"; fields(i)%grid="grid_N_3D"528 i = i + 1; fields(i)%vname="e3u_n"; fields(i)%grid="grid_N_3D"529 i = i + 1; fields(i)%vname="e3v_n"; fields(i)%grid="grid_N_3D"530 i = i + 1; fields(i)%vname="surf_ini"; fields(i)%grid="grid_N"531 i = i + 1; fields(i)%vname="e3t_b"; fields(i)%grid="grid_N_3D"532 i = i + 1; fields(i)%vname="hmxl_n"; fields(i)%grid="grid_N_3D"533 i = i + 1; fields(i)%vname="un_bf"; fields(i)%grid="grid_N"534 i = i + 1; fields(i)%vname="vn_bf"; fields(i)%grid="grid_N"535 i = i + 1; fields(i)%vname="hbl"; fields(i)%grid="grid_N"536 i = i + 1; fields(i)%vname="hbli"; fields(i)%grid="grid_N"537 i = i + 1; fields(i)%vname="wn"; fields(i)%grid="grid_N_3D"538 i = i + 1; fields(i)%vname="fwfisf_cav_b"; fields(i)%grid="grid_N"539 i = i + 1; fields(i)%vname="isf_hc_cav_b"; fields(i)%grid="grid_N"540 i = i + 1; fields(i)%vname="isf_sc_cav_b"; fields(i)%grid="grid_N"541 542 IF( i-1 > max_rst_fields) THEN543 WRITE(ctmp1,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small'544 CALL ctl_stop( 'iom_set_rst_vars:', ctmp1 )545 ENDIF546 END SUBROUTINE iom_set_rst_vars547 548 549 SUBROUTINE iom_set_rstw_active(cdrst_file)550 !!---------------------------------------------------------------------551 !! *** SUBROUTINE iom_set_rstw_active ***552 !!553 !! ** Purpose : define file name in XIOS context for writing restart554 !! enable variables present in restart file for writing555 !!---------------------------------------------------------------------556 !sets enabled = .TRUE. for each field in restart file557 427 CHARACTER(len=*) :: cdrst_file 558 428 #if defined key_iomput 559 TYPE(xios_field) :: field_hdl560 429 TYPE(xios_file) :: file_hdl 561 430 TYPE(xios_filegroup) :: filegroup_hdl … … 577 446 ENDIF 578 447 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 448 #endif 449 END SUBROUTINE iom_set_rstw_file 450 451 452 SUBROUTINE iom_set_rstw_active(sdfield, rd0, rd1, rd2, rd3) 453 !!--------------------------------------------------------------------- 454 !! *** SUBROUTINE iom_set_rstw_active *** 455 !! 456 !! ** Purpose : define file name in XIOS context for writing restart 457 !! enable variables present in restart file for writing 458 !!--------------------------------------------------------------------- 459 !sets enabled = .TRUE. for each field in restart file 460 CHARACTER(len = *), INTENT(IN) :: sdfield 461 REAL(wp), OPTIONAL, INTENT(IN) :: rd0 462 REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rd1 463 REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rd2 464 REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3 465 #if defined key_iomput 466 TYPE(xios_field) :: field_hdl 467 TYPE(xios_file) :: file_hdl 468 INTEGER :: i 469 CHARACTER(lc) :: clpath 470 CHARACTER(len=1024) :: fname 471 CHARACTER(len=lc) :: axis_ref 472 473 CALL xios_get_handle("wrestart", file_hdl) 474 ! CALL xios_get_file_attr("wrestart", name = fname ) 475 ! IF(lwp) write(numout, *) TRIM(fname), ' File to write' 476 ! IF(lwp) call flush(numout) 579 477 !define fields for restart context 580 DO i = 1, max_rst_fields 581 IF( rst_wfields(i)%active ) THEN 582 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname)) 583 SELECT CASE (TRIM(rst_wfields(i)%grid)) 584 CASE ("grid_N_3D") 585 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 586 domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant") 587 CASE ("grid_N") 588 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 589 domain_ref="grid_N", prec = 8, operation = "instant") 590 CASE ("grid_vector") 591 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 592 axis_ref="nav_lev", prec = 8, operation = "instant") 593 CASE ("grid_scalar") 594 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 595 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 596 END SELECT 597 ENDIF 598 END DO 478 CALL xios_add_child(file_hdl, field_hdl, TRIM(sdfield)) 479 480 IF(PRESENT(rd3)) THEN 481 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(sdfield), & 482 domain_ref="grid_N", axis_ref=TRIM(iom_axis(size(rd3, 3))), & 483 prec = 8, operation = "instant") 484 ENDIF 485 486 IF(PRESENT(rd2)) THEN 487 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(sdfield), & 488 domain_ref="grid_N", prec = 8, operation = "instant") 489 ENDIF 490 491 IF(PRESENT(rd1)) THEN 492 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(sdfield), & 493 axis_ref=TRIM(iom_axis(size(rd1, 1))), prec = 8, operation = "instant") 494 ENDIF 495 496 IF(PRESENT(rd0)) THEN 497 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(sdfield), & 498 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 499 ENDIF 599 500 #endif 600 501 END SUBROUTINE iom_set_rstw_active 502 503 FUNCTION iom_axis(idlev) result(axis_ref) 504 !!--------------------------------------------------------------------- 505 !! *** FUNCTION iom_axis *** 506 !! 507 !! ** Purpose : Used for grid definition when XIOS is used to read/write 508 !! restart. Returns axis corresponding to the number of levels 509 !! given as an input variable. Axes are defined in routine 510 !! iom_set_rst_context 511 !!--------------------------------------------------------------------- 512 INTEGER, INTENT(IN) :: idlev 513 CHARACTER(len=lc) :: axis_ref 514 CHARACTER(len=12) :: str 515 IF(idlev == jpk) THEN 516 axis_ref="nav_lev" 517 #if defined key_si3 518 ELSEIF(idlev == jpl) THEN 519 axis_ref="numcat" 520 #endif 521 ELSE 522 write(str, *) idlev 523 CALL ctl_stop( 'iom_axis', 'Definition for axis with '//TRIM(ADJUSTL(str))//' levels missing') 524 ENDIF 525 END FUNCTION iom_axis 601 526 602 527 SUBROUTINE iom_set_rst_context(ld_rstr) … … 609 534 !!--------------------------------------------------------------------- 610 535 LOGICAL, INTENT(IN) :: ld_rstr 611 !ld_rstr is true for restart context. There is no need to define grid for 612 !restart read, because it's read from file 536 INTEGER :: ji 613 537 #if defined key_iomput 614 538 TYPE(xios_domaingroup) :: domaingroup_hdl … … 629 553 CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 630 554 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 555 #if defined key_si3 556 CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat") 557 CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,wp), ji=1,jpl) /) ) 558 #endif 631 559 632 560 CALL xios_get_handle("scalar_definition", scalargroup_hdl) … … 974 902 #if defined key_iomput 975 903 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 976 CALL iom_swap( TRIM(crxios_context) )977 904 CALL xios_recv_field( trim(cdvar), pvar) 978 CALL iom_swap( TRIM(cxios_context) )979 905 #else 980 906 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 1327 1253 #if defined key_iomput 1328 1254 !would be good to be able to check which context is active and swap only if current is not restart 1329 CALL iom_swap( TRIM(crxios_context) )1330 1255 IF( PRESENT(pv_r3d) ) THEN 1331 1256 pv_r3d(:, :, :) = 0. … … 1347 1272 CALL xios_recv_field( trim(cdvar), pv_r1d) 1348 1273 ENDIF 1349 CALL iom_swap( TRIM(cxios_context) )1350 1274 #else 1351 1275 istop = istop + 1 … … 1561 1485 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1562 1486 CALL xios_send_field(trim(cdvar), pvar) 1487 ELSE 1488 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1489 CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar ) 1563 1490 ENDIF 1564 1491 #endif … … 1591 1518 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1592 1519 CALL xios_send_field(trim(cdvar), pvar) 1520 ELSE 1521 IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D) ',trim(cdvar) 1522 CALL iom_set_rstw_active( trim(cdvar), rd1 = pvar ) 1593 1523 ENDIF 1594 1524 #endif … … 1621 1551 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1622 1552 CALL xios_send_field(trim(cdvar), pvar) 1553 ELSE 1554 IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D) ',trim(cdvar) 1555 CALL iom_set_rstw_active( trim(cdvar), rd2 = pvar ) 1623 1556 ENDIF 1624 1557 #endif … … 1651 1584 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1652 1585 CALL xios_send_field(trim(cdvar), pvar) 1586 ELSE 1587 IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D) ',trim(cdvar) 1588 CALL iom_set_rstw_active( trim(cdvar), rd3 = pvar ) 1653 1589 ENDIF 1654 1590 #endif
Note: See TracChangeset
for help on using the changeset viewer.
