Changeset 13970 for NEMO/trunk/src/OCE/IOM/iom.F90
- Timestamp:
- 2020-12-02T10:56:33+01:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/IOM/iom.F90 (modified) (59 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/IOM/iom.F90
r13747 r13970 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 … … 58 60 PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put 59 61 PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val 62 PUBLIC iom_xios_setid 60 63 61 64 PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp … … 69 72 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 70 73 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate 71 PRIVATE iom_set_rst_context, iom_set_ rstw_active, iom_set_rstr_active74 PRIVATE iom_set_rst_context, iom_set_vars_active 72 75 # endif 73 PUBLIC iom_set_rstw_var_active, iom_set_rstw_core, iom_set_rst_vars 76 PRIVATE set_xios_context 77 PRIVATE iom_set_rstw_active 74 78 75 79 INTERFACE iom_get … … 101 105 CONTAINS 102 106 103 SUBROUTINE iom_init( cdname, fname, ld_closedef )107 SUBROUTINE iom_init( cdname, kdid, ld_closedef ) 104 108 !!---------------------------------------------------------------------- 105 109 !! *** ROUTINE *** … … 109 113 !!---------------------------------------------------------------------- 110 114 CHARACTER(len=*), INTENT(in) :: cdname 111 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname115 INTEGER , OPTIONAL, INTENT(in) :: kdid 112 116 LOGICAL , OPTIONAL, INTENT(in) :: ld_closedef 113 117 #if defined key_iomput … … 118 122 INTEGER :: irefyear, irefmonth, irefday 119 123 INTEGER :: ji 120 LOGICAL :: llrst_context ! is context related to restart 124 LOGICAL :: llrst_context ! is context related to restart 125 LOGICAL :: llrstr, llrstw 126 INTEGER :: inum 121 127 ! 122 128 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 123 129 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 124 LOGICAL :: ll_closedef = .TRUE.130 LOGICAL :: ll_closedef 125 131 LOGICAL :: ll_exist 126 132 !!---------------------------------------------------------------------- 127 133 ! 134 ll_closedef = .TRUE. 128 135 IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 129 136 ! … … 134 141 CALL xios_context_initialize(TRIM(clname), mpi_comm_oce) 135 142 CALL iom_swap( cdname ) 136 llrst_context = (TRIM(cdname) == TRIM(crxios_context) .OR. TRIM(cdname) == TRIM(cwxios_context)) 143 144 llrstr = (cdname == cr_ocerst_cxt) .OR. (cdname == cr_icerst_cxt) 145 llrstr = llrstr .OR. (cdname == cr_toprst_cxt) 146 llrstr = llrstr .OR. (cdname == cr_sedrst_cxt) 147 148 llrstw = (cdname == cw_ocerst_cxt) .OR. (cdname == cw_icerst_cxt) 149 llrstw = llrstw .OR. (cdname == cw_toprst_cxt) 150 llrstw = llrstw .OR. (cdname == cw_sedrst_cxt) 151 152 llrst_context = llrstr .OR. llrstw 137 153 138 154 ! Calendar type is now defined in xml file … … 153 169 IF(.NOT.llrst_context) CALL set_scalar 154 170 ! 155 IF( TRIM(cdname) == TRIM(cxios_context)) THEN171 IF( cdname == cxios_context ) THEN 156 172 CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 157 173 CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. ) … … 197 213 ! vertical grid definition 198 214 IF(.NOT.llrst_context) THEN 199 200 201 202 215 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 216 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 217 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 218 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 203 219 204 220 ! ABL 205 206 207 208 209 210 211 221 IF( .NOT. ALLOCATED(ght_abl) ) THEN ! force definition for xml files (xios) 222 ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) ) ! default allocation needed by iom 223 ght_abl(:) = -1._wp ; ghw_abl(:) = -1._wp 224 e3t_abl(:) = -1._wp ; e3w_abl(:) = -1._wp 225 ENDIF 226 CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 227 CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 212 228 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 229 ! Add vertical grid bounds 230 zt_bnds(2,: ) = gdept_1d(:) 231 zt_bnds(1,2:jpk ) = gdept_1d(1:jpkm1) 232 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 233 zw_bnds(1,: ) = gdepw_1d(:) 234 zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 235 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 236 CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 237 CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) 238 CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 239 CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 240 241 ! ABL 242 za_bnds(1,:) = ghw_abl(1:jpkam1) 243 za_bnds(2,:) = ghw_abl(2:jpka ) 244 CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds ) 245 za_bnds(1,:) = ght_abl(2:jpka ) 246 za_bnds(2,:) = ght_abl(2:jpka ) + e3w_abl(2:jpka) 247 CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 248 249 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 234 250 # if defined key_si3 235 236 237 251 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 252 ! SIMIP diagnostics (4 main arctic straits) 253 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 238 254 # endif 239 255 #if defined key_top 240 241 #endif 242 243 244 245 246 247 248 249 256 IF( ALLOCATED(profsed) ) CALL iom_set_axis_attr( "profsed", paxis = profsed ) 257 #endif 258 CALL iom_set_axis_attr( "icbcla", class_num ) 259 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) ! strange syntaxe and idea... 260 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) ) ! strange syntaxe and idea... 261 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea... 262 ! for diaprt, we need to define an axis which size can be 1 (default) or 5 (if the file subbasins.nc exists) 263 INQUIRE( FILE = 'subbasins.nc', EXIST = ll_exist ) 264 nbasin = 1 + 4 * COUNT( (/ll_exist/) ) 265 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,nbasin) /) ) 250 266 ENDIF 251 267 ! 252 268 ! automatic definitions of some of the xml attributs 253 IF( TRIM(cdname) == TRIM(crxios_context) ) THEN 254 !set names of the fields in restart file IF using XIOS to read data 255 CALL iom_set_rst_context(.TRUE.) 256 CALL iom_set_rst_vars(rst_rfields) 257 !set which fields are to be read from restart file 258 CALL iom_set_rstr_active() 259 ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 260 !set names of the fields in restart file IF using XIOS to write data 261 CALL iom_set_rst_context(.FALSE.) 262 CALL iom_set_rst_vars(rst_wfields) 263 !set which fields are to be written to a restart file 264 CALL iom_set_rstw_active(fname) 269 IF(llrstr) THEN 270 IF(PRESENT(kdid)) THEN 271 CALL iom_set_rst_context(.TRUE.) 272 !set which fields will be read from restart file 273 CALL iom_set_vars_active(kdid) 274 ELSE 275 CALL ctl_stop( 'iom_init:', 'restart read with XIOS: missing pointer to NETCDF file' ) 276 ENDIF 277 ELSE IF(llrstw) THEN 278 CALL iom_set_rstw_file(iom_file(kdid)%name) 265 279 ELSE 266 280 CALL set_xmlatt 267 281 ENDIF 268 282 ! … … 280 294 END SUBROUTINE iom_init 281 295 282 SUBROUTINE iom_init_closedef 296 SUBROUTINE iom_init_closedef(cdname) 283 297 !!---------------------------------------------------------------------- 284 298 !! *** SUBROUTINE iom_init_closedef *** … … 288 302 !! 289 303 !!---------------------------------------------------------------------- 290 304 CHARACTER(len=*), OPTIONAL, INTENT(IN) :: cdname 291 305 #if defined key_iomput 292 CALL xios_close_context_definition() 293 CALL xios_update_calendar( 0 ) 306 LOGICAL :: llrstw 307 308 llrstw = .FALSE. 309 IF(PRESENT(cdname)) THEN 310 llrstw = (cdname == cw_ocerst_cxt) 311 llrstw = llrstw .OR. (cdname == cw_icerst_cxt) 312 llrstw = llrstw .OR. (cdname == cw_toprst_cxt) 313 llrstw = llrstw .OR. (cdname == cw_sedrst_cxt) 314 ENDIF 315 316 IF( llrstw ) THEN 317 !set names of the fields in restart file IF using XIOS to write data 318 CALL iom_set_rst_context(.FALSE.) 319 CALL xios_close_context_definition() 320 ELSE 321 CALL xios_close_context_definition() 322 CALL xios_update_calendar( 0 ) 323 ENDIF 294 324 #else 295 325 IF( .FALSE. ) WRITE(numout,*) 'iom_init_closedef: should not see this' ! useless statement to avoid compilation warnings … … 298 328 END SUBROUTINE iom_init_closedef 299 329 300 SUBROUTINE iom_set_ rstw_var_active(field)330 SUBROUTINE iom_set_vars_active(idnum) 301 331 !!--------------------------------------------------------------------- 302 !! *** SUBROUTINE iom_set_rstw_var_active *** 303 !! 304 !! ** Purpose : enable variable in restart file when writing with XIOS 332 !! *** SUBROUTINE iom_set_vars_active *** 333 !! 334 !! ** Purpose : define filename in XIOS context for reading file, 335 !! enable variables present in a file for reading with XIOS 336 !! id of the file is assumed to be rrestart. 305 337 !!--------------------------------------------------------------------- 306 CHARACTER(len = *), INTENT(IN) :: field 307 INTEGER :: i 308 LOGICAL :: llis_set 309 CHARACTER(LEN=256) :: clinfo ! info character 310 338 INTEGER, INTENT(IN) :: idnum 339 311 340 #if defined key_iomput 312 llis_set = .FALSE. 313 314 DO i = 1, max_rst_fields 315 IF(TRIM(rst_wfields(i)%vname) == field) THEN 316 rst_wfields(i)%active = .TRUE. 317 llis_set = .TRUE. 318 EXIT 319 ENDIF 320 ENDDO 321 !Warn if variable is not in defined in rst_wfields 322 IF(.NOT.llis_set) THEN 323 WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 324 CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 ) 325 ENDIF 326 #else 327 clinfo = 'iom_set_rstw_var_active: key_iomput is needed to use XIOS restart read/write functionality' 328 CALL ctl_stop('STOP', TRIM(clinfo)) 329 #endif 330 331 END SUBROUTINE iom_set_rstw_var_active 332 333 SUBROUTINE iom_set_rstr_active() 341 INTEGER :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims 342 TYPE(xios_field) :: field_hdl 343 TYPE(xios_file) :: file_hdl 344 TYPE(xios_filegroup) :: filegroup_hdl 345 INTEGER :: dimids(4), jv,i, idim 346 CHARACTER(LEN=256) :: clinfo ! info character 347 INTEGER, ALLOCATABLE :: indimlens(:) 348 CHARACTER(LEN=nf90_max_name), ALLOCATABLE :: indimnames(:) 349 CHARACTER(LEN=nf90_max_name) :: dimname, varname 350 INTEGER :: iln 351 CHARACTER(LEN=lc) :: fname 352 LOGICAL :: lmeta 353 !metadata in restart file for restart read with XIOS 354 INTEGER, PARAMETER :: NMETA = 10 355 CHARACTER(LEN=lc) :: meta(NMETA) 356 357 358 meta(1) = "nav_lat" 359 meta(2) = "nav_lon" 360 meta(3) = "nav_lev" 361 meta(4) = "time_instant" 362 meta(5) = "time_instant_bounds" 363 meta(6) = "time_counter" 364 meta(7) = "time_counter_bounds" 365 meta(8) = "x" 366 meta(9) = "y" 367 meta(10) = "numcat" 368 369 clinfo = ' iom_set_vars_active, file: '//TRIM(iom_file(idnum)%name) 370 371 iln = INDEX( iom_file(idnum)%name, '.nc' ) 372 !XIOS doee not need .nc 373 IF(iln > 0) THEN 374 fname = iom_file(idnum)%name(1:iln-1) 375 ELSE 376 fname = iom_file(idnum)%name 377 ENDIF 378 379 !set name of the restart file and enable available fields 380 CALL xios_get_handle("file_definition", filegroup_hdl ) 381 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 382 CALL xios_set_file_attr( "rrestart", name=fname, type="one_file", & 383 par_access="collective", enabled=.TRUE., mode="read", & 384 output_freq=xios_timestep ) 385 386 CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, ndims, nvars, natts ), clinfo ) 387 ALLOCATE(indimlens(ndims), indimnames(ndims)) 388 CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, unlimitedDimId = unlimitedDimId ), clinfo ) 389 390 DO idim = 1, ndims 391 CALL iom_nf90_check( nf90_inquire_dimension(iom_file(idnum)%nfid, idim, dimname, dimlen ), clinfo ) 392 indimlens(idim) = dimlen 393 indimnames(idim) = dimname 394 ENDDO 395 396 DO jv =1, nvars 397 lmeta = .FALSE. 398 CALL iom_nf90_check( nf90_inquire_variable(iom_file(idnum)%nfid, jv, varname, xtype, ndims, dimids, natts ), clinfo ) 399 DO i = 1, NMETA 400 IF(varname == meta(i)) THEN 401 lmeta = .TRUE. 402 ENDIF 403 ENDDO 404 IF(.NOT.lmeta) THEN 405 CALL xios_add_child(file_hdl, field_hdl, varname) 406 mdims = ndims 407 408 IF(ANY(dimids(1:ndims) == unlimitedDimId)) THEN 409 mdims = mdims - 1 410 ENDIF 411 412 IF(mdims == 3) THEN 413 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 414 domain_ref="grid_N", & 415 axis_ref=iom_axis(indimlens(dimids(mdims))), & 416 prec = 8, operation = "instant" ) 417 ELSEIF(mdims == 2) THEN 418 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 419 domain_ref="grid_N", prec = 8, & 420 operation = "instant" ) 421 ELSEIF(mdims == 1) THEN 422 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 423 axis_ref=iom_axis(indimlens(dimids(mdims))), & 424 prec = 8, operation = "instant" ) 425 ELSEIF(mdims == 0) THEN 426 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 427 scalar_ref = "grid_scalar", prec = 8, & 428 operation = "instant" ) 429 ELSE 430 WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 431 CALL ctl_stop( 'iom_set_vars_active:', ctmp1 ) 432 ENDIF 433 ENDIF 434 ENDDO 435 DEALLOCATE(indimlens, indimnames) 436 #endif 437 END SUBROUTINE iom_set_vars_active 438 439 SUBROUTINE iom_set_rstw_file(cdrst_file) 334 440 !!--------------------------------------------------------------------- 335 !! *** SUBROUTINE iom_set_rstr_active *** 336 !! 337 !! ** Purpose : define file name in XIOS context for reading restart file, 338 !! enable variables present in restart file for reading with XIOS 441 !! *** SUBROUTINE iom_set_rstw_file *** 442 !! 443 !! ** Purpose : define file name in XIOS context for writing restart 339 444 !!--------------------------------------------------------------------- 340 341 !sets enabled = .TRUE. for each field in restart file 342 CHARACTER(len=256) :: rst_file 343 445 CHARACTER(len=*) :: cdrst_file 344 446 #if defined key_iomput 345 TYPE(xios_field) :: field_hdl 346 TYPE(xios_file) :: file_hdl 347 TYPE(xios_filegroup) :: filegroup_hdl 348 INTEGER :: i 349 CHARACTER(lc) :: clpath 350 351 clpath = TRIM(cn_ocerst_indir) 352 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 353 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 354 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 355 ELSE 356 rst_file = TRIM(clpath)//TRIM(Agrif_CFixed())//'_'//TRIM(cn_ocerst_in) 357 ENDIF 447 TYPE(xios_file) :: file_hdl 448 TYPE(xios_filegroup) :: filegroup_hdl 449 358 450 !set name of the restart file and enable available fields 359 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file 360 CALL xios_get_handle("file_definition", filegroup_hdl ) 361 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 362 CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", & 363 par_access="collective", enabled=.TRUE., mode="read", & 364 output_freq=xios_timestep) 365 !define variables for restart context 366 DO i = 1, max_rst_fields 367 IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN 368 IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 369 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname)) 370 SELECT CASE (TRIM(rst_rfields(i)%grid)) 371 CASE ("grid_N_3D") 372 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 373 domain_ref="grid_N", axis_ref="nav_lev", operation = "instant") 374 CASE ("grid_N") 375 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 376 domain_ref="grid_N", operation = "instant") 377 CASE ("grid_vector") 378 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 379 axis_ref="nav_lev", operation = "instant") 380 CASE ("grid_scalar") 381 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 382 scalar_ref = "grid_scalar", operation = "instant") 383 END SELECT 384 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file) 385 ENDIF 386 ENDIF 387 END DO 388 #endif 389 END SUBROUTINE iom_set_rstr_active 390 391 SUBROUTINE iom_set_rstw_core(cdmdl) 392 !!--------------------------------------------------------------------- 393 !! *** SUBROUTINE iom_set_rstw_core *** 394 !! 395 !! ** Purpose : set variables which are always in restart file 396 !!--------------------------------------------------------------------- 397 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS 398 CHARACTER(LEN=256) :: clinfo ! info character 399 #if defined key_iomput 400 IF(cdmdl == "OPA") THEN 401 !from restart.F90 402 CALL iom_set_rstw_var_active("rn_Dt") 403 IF ( .NOT. ln_diurnal_only ) THEN 404 CALL iom_set_rstw_var_active('ub' ) 405 CALL iom_set_rstw_var_active('vb' ) 406 CALL iom_set_rstw_var_active('tb' ) 407 CALL iom_set_rstw_var_active('sb' ) 408 CALL iom_set_rstw_var_active('sshb') 409 ! 410 CALL iom_set_rstw_var_active('un' ) 411 CALL iom_set_rstw_var_active('vn' ) 412 CALL iom_set_rstw_var_active('tn' ) 413 CALL iom_set_rstw_var_active('sn' ) 414 CALL iom_set_rstw_var_active('sshn') 415 CALL iom_set_rstw_var_active('rhop') 416 ENDIF 417 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 418 !from trasbc.F90 419 CALL iom_set_rstw_var_active('sbc_hc_b') 420 CALL iom_set_rstw_var_active('sbc_sc_b') 421 ENDIF 422 #else 423 clinfo = 'iom_set_rstw_core: key_iomput is needed to use XIOS restart read/write functionality' 424 CALL ctl_stop('STOP', TRIM(clinfo)) 425 #endif 426 END SUBROUTINE iom_set_rstw_core 427 428 SUBROUTINE iom_set_rst_vars(fields) 429 !!--------------------------------------------------------------------- 430 !! *** SUBROUTINE iom_set_rst_vars *** 431 !! 432 !! ** Purpose : Fill array fields with the information about all 433 !! possible variables and corresponding grids definition 434 !! for reading/writing restart with XIOS 435 !!--------------------------------------------------------------------- 436 TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields) 437 INTEGER :: i 438 439 i = 0 440 i = i + 1; fields(i)%vname="rn_Dt"; fields(i)%grid="grid_scalar" 441 i = i + 1; fields(i)%vname="un"; fields(i)%grid="grid_N_3D" 442 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D" 443 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D" 444 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D" 445 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D" 446 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D" 447 i = i + 1; fields(i)%vname="sn"; fields(i)%grid="grid_N_3D" 448 i = i + 1; fields(i)%vname="sb"; fields(i)%grid="grid_N_3D" 449 i = i + 1; fields(i)%vname="sshn"; fields(i)%grid="grid_N" 450 i = i + 1; fields(i)%vname="sshb"; fields(i)%grid="grid_N" 451 i = i + 1; fields(i)%vname="rhop"; fields(i)%grid="grid_N_3D" 452 i = i + 1; fields(i)%vname="kt"; fields(i)%grid="grid_scalar" 453 i = i + 1; fields(i)%vname="ndastp"; fields(i)%grid="grid_scalar" 454 i = i + 1; fields(i)%vname="adatrj"; fields(i)%grid="grid_scalar" 455 i = i + 1; fields(i)%vname="utau_b"; fields(i)%grid="grid_N" 456 i = i + 1; fields(i)%vname="vtau_b"; fields(i)%grid="grid_N" 457 i = i + 1; fields(i)%vname="qns_b"; fields(i)%grid="grid_N" 458 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N" 459 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N" 460 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D" 461 i = i + 1; fields(i)%vname="avt_k"; fields(i)%grid="grid_N_3D" 462 i = i + 1; fields(i)%vname="avm_k"; fields(i)%grid="grid_N_3D" 463 i = i + 1; fields(i)%vname="dissl"; fields(i)%grid="grid_N_3D" 464 i = i + 1; fields(i)%vname="sbc_hc_b"; fields(i)%grid="grid_N" 465 i = i + 1; fields(i)%vname="sbc_sc_b"; fields(i)%grid="grid_N" 466 i = i + 1; fields(i)%vname="qsr_hc_b"; fields(i)%grid="grid_N_3D" 467 i = i + 1; fields(i)%vname="fraqsr_1lev"; fields(i)%grid="grid_N" 468 i = i + 1; fields(i)%vname="greenland_icesheet_mass" 469 fields(i)%grid="grid_scalar" 470 i = i + 1; fields(i)%vname="greenland_icesheet_timelapsed" 471 fields(i)%grid="grid_scalar" 472 i = i + 1; fields(i)%vname="greenland_icesheet_mass_roc" 473 fields(i)%grid="grid_scalar" 474 i = i + 1; fields(i)%vname="antarctica_icesheet_mass" 475 fields(i)%grid="grid_scalar" 476 i = i + 1; fields(i)%vname="antarctica_icesheet_timelapsed" 477 fields(i)%grid="grid_scalar" 478 i = i + 1; fields(i)%vname="antarctica_icesheet_mass_roc" 479 fields(i)%grid="grid_scalar" 480 i = i + 1; fields(i)%vname="frc_v"; fields(i)%grid="grid_scalar" 481 i = i + 1; fields(i)%vname="frc_t"; fields(i)%grid="grid_scalar" 482 i = i + 1; fields(i)%vname="frc_s"; fields(i)%grid="grid_scalar" 483 i = i + 1; fields(i)%vname="frc_wn_t"; fields(i)%grid="grid_scalar" 484 i = i + 1; fields(i)%vname="frc_wn_s"; fields(i)%grid="grid_scalar" 485 i = i + 1; fields(i)%vname="ssh_ini"; fields(i)%grid="grid_N" 486 i = i + 1; fields(i)%vname="e3t_ini"; fields(i)%grid="grid_N_3D" 487 i = i + 1; fields(i)%vname="hc_loc_ini"; fields(i)%grid="grid_N_3D" 488 i = i + 1; fields(i)%vname="sc_loc_ini"; fields(i)%grid="grid_N_3D" 489 i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N" 490 i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N" 491 i = i + 1; fields(i)%vname="tilde_e3t_b"; fields(i)%grid="grid_N" 492 i = i + 1; fields(i)%vname="tilde_e3t_n"; fields(i)%grid="grid_N" 493 i = i + 1; fields(i)%vname="hdiv_lf"; fields(i)%grid="grid_N" 494 i = i + 1; fields(i)%vname="ub2_b"; fields(i)%grid="grid_N" 495 i = i + 1; fields(i)%vname="vb2_b"; fields(i)%grid="grid_N" 496 i = i + 1; fields(i)%vname="sshbb_e"; fields(i)%grid="grid_N" 497 i = i + 1; fields(i)%vname="ubb_e"; fields(i)%grid="grid_N" 498 i = i + 1; fields(i)%vname="vbb_e"; fields(i)%grid="grid_N" 499 i = i + 1; fields(i)%vname="sshb_e"; fields(i)%grid="grid_N" 500 i = i + 1; fields(i)%vname="ub_e"; fields(i)%grid="grid_N" 501 i = i + 1; fields(i)%vname="vb_e"; fields(i)%grid="grid_N" 502 i = i + 1; fields(i)%vname="fwf_isf_b"; fields(i)%grid="grid_N" 503 i = i + 1; fields(i)%vname="isf_sc_b"; fields(i)%grid="grid_N" 504 i = i + 1; fields(i)%vname="isf_hc_b"; fields(i)%grid="grid_N" 505 i = i + 1; fields(i)%vname="ssh_ibb"; fields(i)%grid="grid_N" 506 i = i + 1; fields(i)%vname="rnf_b"; fields(i)%grid="grid_N" 507 i = i + 1; fields(i)%vname="rnf_hc_b"; fields(i)%grid="grid_N" 508 i = i + 1; fields(i)%vname="rnf_sc_b"; fields(i)%grid="grid_N" 509 i = i + 1; fields(i)%vname="nn_fsbc"; fields(i)%grid="grid_scalar" 510 i = i + 1; fields(i)%vname="ssu_m"; fields(i)%grid="grid_N" 511 i = i + 1; fields(i)%vname="ssv_m"; fields(i)%grid="grid_N" 512 i = i + 1; fields(i)%vname="sst_m"; fields(i)%grid="grid_N" 513 i = i + 1; fields(i)%vname="sss_m"; fields(i)%grid="grid_N" 514 i = i + 1; fields(i)%vname="ssh_m"; fields(i)%grid="grid_N" 515 i = i + 1; fields(i)%vname="e3t_m"; fields(i)%grid="grid_N" 516 i = i + 1; fields(i)%vname="frq_m"; fields(i)%grid="grid_N" 517 i = i + 1; fields(i)%vname="avmb"; fields(i)%grid="grid_vector" 518 i = i + 1; fields(i)%vname="avtb"; fields(i)%grid="grid_vector" 519 i = i + 1; fields(i)%vname="ub2_i_b"; fields(i)%grid="grid_N" 520 i = i + 1; fields(i)%vname="vb2_i_b"; fields(i)%grid="grid_N" 521 i = i + 1; fields(i)%vname="ntime"; fields(i)%grid="grid_scalar" 522 i = i + 1; fields(i)%vname="Dsst"; fields(i)%grid="grid_scalar" 523 i = i + 1; fields(i)%vname="tmask"; fields(i)%grid="grid_N_3D" 524 i = i + 1; fields(i)%vname="umask"; fields(i)%grid="grid_N_3D" 525 i = i + 1; fields(i)%vname="vmask"; fields(i)%grid="grid_N_3D" 526 i = i + 1; fields(i)%vname="smask"; fields(i)%grid="grid_N_3D" 527 i = i + 1; fields(i)%vname="gdepw_n"; fields(i)%grid="grid_N_3D" 528 i = i + 1; fields(i)%vname="e3t_n"; fields(i)%grid="grid_N_3D" 529 i = i + 1; fields(i)%vname="e3u_n"; fields(i)%grid="grid_N_3D" 530 i = i + 1; fields(i)%vname="e3v_n"; fields(i)%grid="grid_N_3D" 531 i = i + 1; fields(i)%vname="surf_ini"; fields(i)%grid="grid_N" 532 i = i + 1; fields(i)%vname="e3t_b"; fields(i)%grid="grid_N_3D" 533 i = i + 1; fields(i)%vname="hmxl_n"; fields(i)%grid="grid_N_3D" 534 i = i + 1; fields(i)%vname="un_bf"; fields(i)%grid="grid_N" 535 i = i + 1; fields(i)%vname="vn_bf"; fields(i)%grid="grid_N" 536 i = i + 1; fields(i)%vname="hbl"; fields(i)%grid="grid_N" 537 i = i + 1; fields(i)%vname="hbli"; fields(i)%grid="grid_N" 538 i = i + 1; fields(i)%vname="wn"; fields(i)%grid="grid_N_3D" 539 540 IF( i-1 > max_rst_fields) THEN 541 WRITE(ctmp1,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small' 542 CALL ctl_stop( 'iom_set_rst_vars:', ctmp1 ) 543 ENDIF 544 END SUBROUTINE iom_set_rst_vars 545 546 547 SUBROUTINE iom_set_rstw_active(cdrst_file) 451 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ', TRIM(cdrst_file) 452 CALL xios_get_handle("file_definition", filegroup_hdl ) 453 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 454 IF(nxioso.eq.1) THEN 455 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 456 mode="write", output_freq=xios_timestep) 457 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 458 ELSE 459 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 460 mode="write", output_freq=xios_timestep) 461 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 462 ENDIF 463 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 464 #endif 465 END SUBROUTINE iom_set_rstw_file 466 467 468 SUBROUTINE iom_set_rstw_active(sdfield, rd0, rs0, rd1, rs1, rd2, rs2, rd3, rs3) 548 469 !!--------------------------------------------------------------------- 549 470 !! *** SUBROUTINE iom_set_rstw_active *** … … 553 474 !!--------------------------------------------------------------------- 554 475 !sets enabled = .TRUE. for each field in restart file 555 CHARACTER(len=*) :: cdrst_file 476 CHARACTER(len = *), INTENT(IN) :: sdfield 477 REAL(dp), OPTIONAL, INTENT(IN) :: rd0 478 REAL(sp), OPTIONAL, INTENT(IN) :: rs0 479 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rd1 480 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rs1 481 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rd2 482 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rs2 483 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3 484 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rs3 556 485 #if defined key_iomput 557 TYPE(xios_field) :: field_hdl 558 TYPE(xios_file) :: file_hdl 559 TYPE(xios_filegroup) :: filegroup_hdl 560 INTEGER :: i 561 CHARACTER(lc) :: clpath 562 563 !set name of the restart file and enable available fields 564 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file 565 CALL xios_get_handle("file_definition", filegroup_hdl ) 566 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 567 IF(nxioso.eq.1) THEN 568 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 569 mode="write", output_freq=xios_timestep) 570 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 571 ELSE 572 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 573 mode="write", output_freq=xios_timestep) 574 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 575 ENDIF 576 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 486 TYPE(xios_field) :: field_hdl 487 TYPE(xios_file) :: file_hdl 488 489 CALL xios_get_handle("wrestart", file_hdl) 577 490 !define fields for restart context 578 DO i = 1, max_rst_fields 579 IF( rst_wfields(i)%active ) THEN 580 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname)) 581 SELECT CASE (TRIM(rst_wfields(i)%grid)) 582 CASE ("grid_N_3D") 583 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 584 domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant") 585 CASE ("grid_N") 586 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 587 domain_ref="grid_N", prec = 8, operation = "instant") 588 CASE ("grid_vector") 589 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 590 axis_ref="nav_lev", prec = 8, operation = "instant") 591 CASE ("grid_scalar") 592 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 593 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 594 END SELECT 595 ENDIF 596 END DO 491 CALL xios_add_child(file_hdl, field_hdl, sdfield) 492 493 IF(PRESENT(rd3)) THEN 494 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 495 domain_ref = "grid_N", & 496 axis_ref = iom_axis(size(rd3, 3)), & 497 prec = 8, operation = "instant" ) 498 ELSEIF(PRESENT(rs3)) THEN 499 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 500 domain_ref = "grid_N", & 501 axis_ref = iom_axis(size(rd3, 3)), & 502 prec = 4, operation = "instant" ) 503 ELSEIF(PRESENT(rd2)) THEN 504 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 505 domain_ref = "grid_N", prec = 8, & 506 operation = "instant" ) 507 ELSEIF(PRESENT(rs2)) THEN 508 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 509 domain_ref = "grid_N", prec = 4, & 510 operation = "instant" ) 511 ELSEIF(PRESENT(rd1)) THEN 512 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 513 axis_ref = iom_axis(size(rd1, 1)), & 514 prec = 8, operation = "instant" ) 515 ELSEIF(PRESENT(rs1)) THEN 516 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 517 axis_ref = iom_axis(size(rd1, 1)), & 518 prec = 4, operation = "instant" ) 519 ELSEIF(PRESENT(rd0)) THEN 520 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 521 scalar_ref = "grid_scalar", prec = 8, & 522 operation = "instant" ) 523 ELSEIF(PRESENT(rs0)) THEN 524 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 525 scalar_ref = "grid_scalar", prec = 4, & 526 operation = "instant" ) 527 ENDIF 597 528 #endif 598 529 END SUBROUTINE iom_set_rstw_active 599 530 531 FUNCTION iom_axis(idlev) result(axis_ref) 532 !!--------------------------------------------------------------------- 533 !! *** FUNCTION iom_axis *** 534 !! 535 !! ** Purpose : Used for grid definition when XIOS is used to read/write 536 !! restart. Returns axis corresponding to the number of levels 537 !! given as an input variable. Axes are defined in routine 538 !! iom_set_rst_context 539 !!--------------------------------------------------------------------- 540 INTEGER, INTENT(IN) :: idlev 541 CHARACTER(len=lc) :: axis_ref 542 CHARACTER(len=12) :: str 543 IF(idlev == jpk) THEN 544 axis_ref="nav_lev" 545 #if defined key_si3 546 ELSEIF(idlev == jpl) THEN 547 axis_ref="numcat" 548 #endif 549 ELSE 550 write(str, *) idlev 551 CALL ctl_stop( 'iom_axis', 'Definition for axis with '//TRIM(ADJUSTL(str))//' levels missing') 552 ENDIF 553 END FUNCTION iom_axis 554 555 FUNCTION iom_xios_setid(cdname) result(kid) 556 !!--------------------------------------------------------------------- 557 !! *** FUNCTION *** 558 !! 559 !! ** Purpose : this function returns first available id to keep information about file 560 !! sets filename in iom_file structure and sets name 561 !! of XIOS context depending on cdcomp 562 !! corresponds to iom_nf90_open 563 !!--------------------------------------------------------------------- 564 CHARACTER(len=*), INTENT(in ) :: cdname ! File name 565 INTEGER :: kid ! identifier of the opened file 566 INTEGER :: jl 567 568 kid = 0 569 DO jl = jpmax_files, 1, -1 570 IF( iom_file(jl)%nfid == 0 ) kid = jl 571 ENDDO 572 573 iom_file(kid)%name = TRIM(cdname) 574 iom_file(kid)%nfid = 1 575 iom_file(kid)%nvars = 0 576 iom_file(kid)%irec = -1 577 578 END FUNCTION iom_xios_setid 579 600 580 SUBROUTINE iom_set_rst_context(ld_rstr) 601 !!---------------------------------------------------------------------581 !!--------------------------------------------------------------------- 602 582 !! *** SUBROUTINE iom_set_rst_context *** 603 583 !! … … 606 586 !! 607 587 !!--------------------------------------------------------------------- 608 LOGICAL, INTENT(IN) :: ld_rstr 609 !ld_rstr is true for restart context. There is no need to define grid for 610 !restart read, because it's read from file 588 LOGICAL, INTENT(IN) :: ld_rstr 589 INTEGER :: ji 611 590 #if defined key_iomput 612 TYPE(xios_domaingroup) :: domaingroup_hdl613 TYPE(xios_domain) :: domain_hdl614 TYPE(xios_axisgroup) :: axisgroup_hdl615 TYPE(xios_axis) :: axis_hdl616 TYPE(xios_scalar) :: scalar_hdl617 TYPE(xios_scalargroup) :: scalargroup_hdl618 619 CALL xios_get_handle("domain_definition",domaingroup_hdl)620 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")621 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr)591 TYPE(xios_domaingroup) :: domaingroup_hdl 592 TYPE(xios_domain) :: domain_hdl 593 TYPE(xios_axisgroup) :: axisgroup_hdl 594 TYPE(xios_axis) :: axis_hdl 595 TYPE(xios_scalar) :: scalar_hdl 596 TYPE(xios_scalargroup) :: scalargroup_hdl 597 598 CALL xios_get_handle("domain_definition",domaingroup_hdl) 599 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 600 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 622 601 623 CALL xios_get_handle("axis_definition",axisgroup_hdl)624 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev")602 CALL xios_get_handle("axis_definition",axisgroup_hdl) 603 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 625 604 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 626 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 627 CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 628 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 629 630 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 631 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 605 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 606 CALL xios_set_axis_attr( "nav_lev", long_name = "Vertical levels in meters", positive = "down") 607 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 608 #if defined key_si3 609 CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat") 610 CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,wp), ji=1,jpl) /) ) 611 #endif 612 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 613 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 632 614 #endif 633 615 END SUBROUTINE iom_set_rst_context 616 617 618 SUBROUTINE set_xios_context(kdid, cdcont) 619 !!--------------------------------------------------------------------- 620 !! *** SUBROUTINE iom_set_rst_context *** 621 !! 622 !! ** Purpose : set correct XIOS context based on kdid 623 !! 624 !!--------------------------------------------------------------------- 625 INTEGER, INTENT(IN) :: kdid ! Identifier of the file 626 CHARACTER(LEN=lc), INTENT(OUT) :: cdcont ! name of the context for XIOS read/write 627 628 cdcont = "NONE" 629 630 IF(lrxios) THEN 631 IF(kdid == numror) THEN 632 cdcont = cr_ocerst_cxt 633 ELSEIF(kdid == numrir) THEN 634 cdcont = cr_icerst_cxt 635 ELSEIF(kdid == numrtr) THEN 636 cdcont = cr_toprst_cxt 637 ELSEIF(kdid == numrsr) THEN 638 cdcont = cr_sedrst_cxt 639 ENDIF 640 ENDIF 641 642 IF(lwxios) THEN 643 IF(kdid == numrow) THEN 644 cdcont = cw_ocerst_cxt 645 ELSEIF(kdid == numriw) THEN 646 cdcont = cw_icerst_cxt 647 ELSEIF(kdid == numrtw) THEN 648 cdcont = cw_toprst_cxt 649 ELSEIF(kdid == numrsw) THEN 650 cdcont = cw_sedrst_cxt 651 ENDIF 652 ENDIF 653 END SUBROUTINE set_xios_context 654 634 655 635 656 SUBROUTINE iom_swap( cdname ) … … 642 663 #if defined key_iomput 643 664 TYPE(xios_context) :: nemo_hdl 644 645 665 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 646 666 CALL xios_get_handle(TRIM(cdname),nemo_hdl) … … 892 912 !! INTERFACE iom_get 893 913 !!---------------------------------------------------------------------- 894 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime , ldxios)914 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime ) 895 915 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 896 916 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable … … 898 918 REAL(dp) :: ztmp_pvar ! tmp var to read field 899 919 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 900 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart901 920 ! 902 921 INTEGER :: idvar ! variable id … … 906 925 CHARACTER(LEN=100) :: clname ! file name 907 926 CHARACTER(LEN=1) :: cldmspc ! 908 LOGICAL :: llxios 909 ! 910 llxios = .FALSE. 911 IF( PRESENT(ldxios) ) llxios = ldxios 912 913 IF(.NOT.llxios) THEN ! read data using default library 927 CHARACTER(LEN=lc) :: context 928 ! 929 CALL set_xios_context(kiomid, context) 930 931 IF(context == "NONE") THEN ! read data using default library 914 932 itime = 1 915 933 IF( PRESENT(ktime) ) itime = ktime … … 934 952 #if defined key_iomput 935 953 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 936 CALL iom_swap( TRIM(crxios_context))954 CALL iom_swap(context) 937 955 CALL xios_recv_field( trim(cdvar), pvar) 938 CALL iom_swap( TRIM(cxios_context))956 CALL iom_swap(cxios_context) 939 957 #else 940 958 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 944 962 END SUBROUTINE iom_g0d_sp 945 963 946 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime , ldxios)964 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime ) 947 965 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 948 966 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 949 967 REAL(dp) , INTENT( out) :: pvar ! read field 950 968 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 951 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart952 969 ! 953 970 INTEGER :: idvar ! variable id … … 957 974 CHARACTER(LEN=100) :: clname ! file name 958 975 CHARACTER(LEN=1) :: cldmspc ! 959 LOGICAL :: llxios 960 ! 961 llxios = .FALSE. 962 IF( PRESENT(ldxios) ) llxios = ldxios 963 964 IF(.NOT.llxios) THEN ! read data using default library 976 CHARACTER(LEN=lc) :: context 977 ! 978 CALL set_xios_context(kiomid, context) 979 980 IF(context == "NONE") THEN ! read data using default library 965 981 itime = 1 966 982 IF( PRESENT(ktime) ) itime = ktime … … 984 1000 #if defined key_iomput 985 1001 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 986 CALL iom_swap( TRIM(crxios_context))1002 CALL iom_swap(context) 987 1003 CALL xios_recv_field( trim(cdvar), pvar) 988 CALL iom_swap( TRIM(cxios_context))1004 CALL iom_swap(cxios_context) 989 1005 #else 990 1006 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 994 1010 END SUBROUTINE iom_g0d_dp 995 1011 996 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)1012 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 997 1013 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 998 1014 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1003 1019 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1004 1020 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1005 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1006 1021 ! 1007 1022 IF( kiomid > 0 ) THEN … … 1009 1024 ALLOCATE(ztmp_pvar(size(pvar,1))) 1010 1025 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=ztmp_pvar, & 1011 & ktime=ktime, kstart=kstart, kcount=kcount, & 1012 & ldxios=ldxios ) 1026 & ktime=ktime, kstart=kstart, kcount=kcount ) 1013 1027 pvar = ztmp_pvar 1014 1028 DEALLOCATE(ztmp_pvar) … … 1018 1032 1019 1033 1020 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)1034 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 1021 1035 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1022 1036 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1026 1040 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1027 1041 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1028 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1029 1042 ! 1030 1043 IF( kiomid > 0 ) THEN 1031 1044 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 1032 & ktime=ktime, kstart=kstart, kcount=kcount, & 1033 & ldxios=ldxios ) 1045 & ktime=ktime, kstart=kstart, kcount=kcount) 1034 1046 ENDIF 1035 1047 END SUBROUTINE iom_g1d_dp 1036 1048 1037 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1049 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount) 1038 1050 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1039 1051 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1047 1059 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1048 1060 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1049 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1050 1061 ! 1051 1062 IF( kiomid > 0 ) THEN … … 1054 1065 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = ztmp_pvar , ktime = ktime, & 1055 1066 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1056 & kstart = kstart , kcount = kcount , ldxios=ldxios)1067 & kstart = kstart , kcount = kcount ) 1057 1068 pvar = ztmp_pvar 1058 1069 DEALLOCATE(ztmp_pvar) … … 1061 1072 END SUBROUTINE iom_g2d_sp 1062 1073 1063 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1074 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount) 1064 1075 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1065 1076 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1072 1083 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1073 1084 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1074 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1075 1085 ! 1076 1086 IF( kiomid > 0 ) THEN 1077 1087 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = pvar , ktime = ktime, & 1078 1088 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1079 & kstart = kstart , kcount = kcount , ldxios=ldxios)1089 & kstart = kstart , kcount = kcount ) 1080 1090 ENDIF 1081 1091 END SUBROUTINE iom_g2d_dp 1082 1092 1083 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1093 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount ) 1084 1094 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1085 1095 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1093 1103 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1094 1104 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1095 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1096 1105 ! 1097 1106 IF( kiomid > 0 ) THEN … … 1100 1109 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = ztmp_pvar , ktime = ktime, & 1101 1110 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1102 & kstart = kstart , kcount = kcount , ldxios=ldxios)1111 & kstart = kstart , kcount = kcount ) 1103 1112 pvar = ztmp_pvar 1104 1113 DEALLOCATE(ztmp_pvar) … … 1107 1116 END SUBROUTINE iom_g3d_sp 1108 1117 1109 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1118 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount ) 1110 1119 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1111 1120 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1118 1127 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1119 1128 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1120 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1121 1129 ! 1122 1130 IF( kiomid > 0 ) THEN … … 1124 1132 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1125 1133 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1126 & kstart = kstart , kcount = kcount , ldxios=ldxios)1134 & kstart = kstart , kcount = kcount ) 1127 1135 END IF 1128 1136 ENDIF … … 1132 1140 1133 1141 SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime , & 1134 & cd_type, psgn, kfill, kstart, kcount , ldxios)1142 & cd_type, psgn, kfill, kstart, kcount ) 1135 1143 !!----------------------------------------------------------------------- 1136 1144 !! *** ROUTINE iom_get_123d *** … … 1152 1160 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1153 1161 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1154 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart1155 1162 ! 1156 1163 LOGICAL :: llok ! true if ok! 1157 LOGICAL :: llxios ! local definition for XIOS read1158 1164 INTEGER :: jl ! loop on number of dimension 1159 1165 INTEGER :: idom ! type of domain … … 1182 1188 REAL(dp) :: gma, gmi 1183 1189 !--------------------------------------------------------------------- 1184 ! 1190 CHARACTER(LEN=lc) :: context 1191 ! 1192 CALL set_xios_context(kiomid, context) 1185 1193 inlev = -1 1186 1194 IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3) 1187 1195 ! 1188 llxios = .FALSE.1189 IF( PRESENT(ldxios) ) llxios = ldxios1190 !1191 1196 idom = kdom 1192 1197 istop = nstop 1193 1198 ! 1194 IF( .NOT.llxios) THEN1199 IF(context == "NONE") THEN 1195 1200 clname = iom_file(kiomid)%name ! esier to read 1196 1201 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) … … 1359 1364 #if defined key_iomput 1360 1365 !would be good to be able to check which context is active and swap only if current is not restart 1361 CALL iom_swap( TRIM(crxios_context) ) 1366 idvar = iom_varid( kiomid, cdvar ) 1367 CALL iom_swap(context) 1368 zsgn = 1._wp 1369 IF( PRESENT(psgn ) ) zsgn = psgn 1370 cl_type = 'T' 1371 IF( PRESENT(cd_type) ) cl_type = cd_type 1372 1362 1373 IF( PRESENT(pv_r3d) ) THEN 1363 1374 IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 1364 CALL xios_recv_field( trim(cdvar), pv_r3d) 1365 IF(idom /= jpdom_unknown ) CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1375 CALL xios_recv_field( trim(cdvar), pv_r3d(:, :, :)) 1376 IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1377 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill) 1378 ENDIF 1366 1379 ELSEIF( PRESENT(pv_r2d) ) THEN 1367 1380 IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 1368 CALL xios_recv_field( trim(cdvar), pv_r2d) 1369 IF(idom /= jpdom_unknown ) CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1381 CALL xios_recv_field( trim(cdvar), pv_r2d(:, :)) 1382 IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1383 CALL lbc_lnk('iom', pv_r2d, cl_type, zsgn, kfillmode = kfill) 1384 ENDIF 1370 1385 ELSEIF( PRESENT(pv_r1d) ) THEN 1371 1386 IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 1372 1387 CALL xios_recv_field( trim(cdvar), pv_r1d) 1373 1388 ENDIF 1374 CALL iom_swap( TRIM(cxios_context))1389 CALL iom_swap(cxios_context) 1375 1390 #else 1376 1391 istop = istop + 1 … … 1387 1402 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1388 1403 IF( PRESENT(pv_r1d) ) THEN 1389 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf1390 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs1404 IF( zscf /= 1._wp ) pv_r1d(:) = pv_r1d(:) * zscf 1405 IF( zofs /= 0._wp ) pv_r1d(:) = pv_r1d(:) + zofs 1391 1406 ELSEIF( PRESENT(pv_r2d) ) THEN 1392 IF( zscf /= 1. ) pv_r2d(:,:) = pv_r2d(:,:) * zscf1393 IF( zofs /= 0. ) pv_r2d(:,:) = pv_r2d(:,:) + zofs1407 IF( zscf /= 1._wp) pv_r2d(:,:) = pv_r2d(:,:) * zscf 1408 IF( zofs /= 0._wp) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1394 1409 ELSEIF( PRESENT(pv_r3d) ) THEN 1395 IF( zscf /= 1. ) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf1396 IF( zofs /= 0. ) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs1410 IF( zscf /= 1._wp) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 1411 IF( zofs /= 0._wp) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 1397 1412 ENDIF 1398 1413 ! … … 1568 1583 !! INTERFACE iom_rstput 1569 1584 !!---------------------------------------------------------------------- 1570 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1585 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1571 1586 INTEGER , INTENT(in) :: kt ! ocean time-step 1572 1587 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1575 1590 REAL(sp) , INTENT(in) :: pvar ! written field 1576 1591 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1577 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1578 LOGICAL :: llx ! local xios write flag 1579 INTEGER :: ivid ! variable id 1580 1581 llx = .FALSE. 1582 IF(PRESENT(ldxios)) llx = ldxios 1592 ! 1593 LOGICAL :: llx ! local xios write flag 1594 INTEGER :: ivid ! variable id 1595 CHARACTER(LEN=lc) :: context 1596 ! 1597 CALL set_xios_context(kiomid, context) 1598 1599 llx = .NOT. (context == "NONE") 1600 1583 1601 IF( llx ) THEN 1584 1602 #ifdef key_iomput 1585 IF( kt == kwrite ) THEN 1586 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1587 CALL xios_send_field(trim(cdvar), pvar) 1588 ENDIF 1603 IF( kt == kwrite ) THEN 1604 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1605 CALL iom_swap(context) 1606 CALL iom_put(trim(cdvar), pvar) 1607 CALL iom_swap(cxios_context) 1608 ELSE 1609 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1610 CALL iom_swap(context) 1611 CALL iom_set_rstw_active( trim(cdvar), rs0 = pvar ) 1612 CALL iom_swap(cxios_context) 1613 ENDIF 1589 1614 #endif 1590 1615 ELSE … … 1598 1623 END SUBROUTINE iom_rp0d_sp 1599 1624 1600 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1625 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1601 1626 INTEGER , INTENT(in) :: kt ! ocean time-step 1602 1627 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1605 1630 REAL(dp) , INTENT(in) :: pvar ! written field 1606 1631 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1607 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1608 LOGICAL :: llx ! local xios write flag 1609 INTEGER :: ivid ! variable id 1610 1611 llx = .FALSE. 1612 IF(PRESENT(ldxios)) llx = ldxios 1632 ! 1633 LOGICAL :: llx ! local xios write flag 1634 INTEGER :: ivid ! variable id 1635 CHARACTER(LEN=lc) :: context 1636 ! 1637 CALL set_xios_context(kiomid, context) 1638 1639 llx = .NOT. (context == "NONE") 1640 1613 1641 IF( llx ) THEN 1614 1642 #ifdef key_iomput 1615 IF( kt == kwrite ) THEN 1616 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1617 CALL xios_send_field(trim(cdvar), pvar) 1618 ENDIF 1643 IF( kt == kwrite ) THEN 1644 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1645 CALL iom_swap(context) 1646 CALL iom_put(trim(cdvar), pvar) 1647 CALL iom_swap(cxios_context) 1648 ELSE 1649 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1650 CALL iom_swap(context) 1651 CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar ) 1652 CALL iom_swap(cxios_context) 1653 ENDIF 1619 1654 #endif 1620 1655 ELSE … … 1629 1664 1630 1665 1631 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1666 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1632 1667 INTEGER , INTENT(in) :: kt ! ocean time-step 1633 1668 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1636 1671 REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1637 1672 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1638 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1639 LOGICAL :: llx ! local xios write flag 1640 INTEGER :: ivid ! variable id 1641 1642 llx = .FALSE. 1643 IF(PRESENT(ldxios)) llx = ldxios 1673 ! 1674 LOGICAL :: llx ! local xios write flag 1675 INTEGER :: ivid ! variable id 1676 CHARACTER(LEN=lc) :: context 1677 ! 1678 CALL set_xios_context(kiomid, context) 1679 1680 llx = .NOT. (context == "NONE") 1681 1644 1682 IF( llx ) THEN 1645 1683 #ifdef key_iomput 1646 IF( kt == kwrite ) THEN 1647 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1648 CALL xios_send_field(trim(cdvar), pvar) 1649 ENDIF 1684 IF( kt == kwrite ) THEN 1685 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1686 CALL iom_swap(context) 1687 CALL iom_put(trim(cdvar), pvar) 1688 CALL iom_swap(cxios_context) 1689 ELSE 1690 IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D)',trim(cdvar) 1691 CALL iom_swap(context) 1692 CALL iom_set_rstw_active( trim(cdvar), rs1 = pvar ) 1693 CALL iom_swap(cxios_context) 1694 ENDIF 1650 1695 #endif 1651 1696 ELSE … … 1659 1704 END SUBROUTINE iom_rp1d_sp 1660 1705 1661 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1706 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1662 1707 INTEGER , INTENT(in) :: kt ! ocean time-step 1663 1708 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1666 1711 REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1667 1712 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1668 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1669 LOGICAL :: llx ! local xios write flag 1670 INTEGER :: ivid ! variable id 1671 1672 llx = .FALSE. 1673 IF(PRESENT(ldxios)) llx = ldxios 1713 ! 1714 LOGICAL :: llx ! local xios write flag 1715 INTEGER :: ivid ! variable id 1716 CHARACTER(LEN=lc) :: context 1717 ! 1718 CALL set_xios_context(kiomid, context) 1719 1720 llx = .NOT. (context == "NONE") 1721 1674 1722 IF( llx ) THEN 1675 1723 #ifdef key_iomput 1676 IF( kt == kwrite ) THEN 1677 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1678 CALL xios_send_field(trim(cdvar), pvar) 1679 ENDIF 1724 IF( kt == kwrite ) THEN 1725 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1726 CALL iom_swap(context) 1727 CALL iom_put(trim(cdvar), pvar) 1728 CALL iom_swap(cxios_context) 1729 ELSE 1730 IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D)',trim(cdvar) 1731 CALL iom_swap(context) 1732 CALL iom_set_rstw_active( trim(cdvar), rd1 = pvar ) 1733 CALL iom_swap(cxios_context) 1734 ENDIF 1680 1735 #endif 1681 1736 ELSE … … 1690 1745 1691 1746 1692 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1747 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1693 1748 INTEGER , INTENT(in) :: kt ! ocean time-step 1694 1749 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1697 1752 REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1698 1753 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1699 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1700 LOGICAL :: llx 1701 INTEGER :: ivid ! variable id 1702 1703 llx = .FALSE. 1704 IF(PRESENT(ldxios)) llx = ldxios 1754 ! 1755 LOGICAL :: llx 1756 INTEGER :: ivid ! variable id 1757 CHARACTER(LEN=lc) :: context 1758 ! 1759 CALL set_xios_context(kiomid, context) 1760 1761 llx = .NOT. (context == "NONE") 1762 1705 1763 IF( llx ) THEN 1706 1764 #ifdef key_iomput 1707 IF( kt == kwrite ) THEN 1708 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1709 CALL xios_send_field(trim(cdvar), pvar) 1710 ENDIF 1765 IF( kt == kwrite ) THEN 1766 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1767 CALL iom_swap(context) 1768 CALL iom_put(trim(cdvar), pvar) 1769 CALL iom_swap(cxios_context) 1770 ELSE 1771 IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D)',trim(cdvar) 1772 CALL iom_swap(context) 1773 CALL iom_set_rstw_active( trim(cdvar), rs2 = pvar ) 1774 CALL iom_swap(cxios_context) 1775 ENDIF 1711 1776 #endif 1712 1777 ELSE … … 1720 1785 END SUBROUTINE iom_rp2d_sp 1721 1786 1722 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1787 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1723 1788 INTEGER , INTENT(in) :: kt ! ocean time-step 1724 1789 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1727 1792 REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1728 1793 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1729 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1730 LOGICAL :: llx 1731 INTEGER :: ivid ! variable id 1732 1733 llx = .FALSE. 1734 IF(PRESENT(ldxios)) llx = ldxios 1794 ! 1795 LOGICAL :: llx 1796 INTEGER :: ivid ! variable id 1797 CHARACTER(LEN=lc) :: context 1798 ! 1799 CALL set_xios_context(kiomid, context) 1800 1801 llx = .NOT. (context == "NONE") 1802 1735 1803 IF( llx ) THEN 1736 1804 #ifdef key_iomput 1737 IF( kt == kwrite ) THEN 1738 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1739 CALL xios_send_field(trim(cdvar), pvar) 1740 ENDIF 1805 IF( kt == kwrite ) THEN 1806 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1807 CALL iom_swap(context) 1808 CALL iom_put(trim(cdvar), pvar) 1809 CALL iom_swap(cxios_context) 1810 ELSE 1811 IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D)',trim(cdvar) 1812 CALL iom_swap(context) 1813 CALL iom_set_rstw_active( trim(cdvar), rd2 = pvar ) 1814 CALL iom_swap(cxios_context) 1815 ENDIF 1741 1816 #endif 1742 1817 ELSE … … 1751 1826 1752 1827 1753 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1828 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1754 1829 INTEGER , INTENT(in) :: kt ! ocean time-step 1755 1830 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1758 1833 REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1759 1834 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1760 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1761 LOGICAL :: llx ! local xios write flag 1762 INTEGER :: ivid ! variable id 1763 1764 llx = .FALSE. 1765 IF(PRESENT(ldxios)) llx = ldxios 1835 ! 1836 LOGICAL :: llx ! local xios write flag 1837 INTEGER :: ivid ! variable id 1838 CHARACTER(LEN=lc) :: context 1839 ! 1840 CALL set_xios_context(kiomid, context) 1841 1842 llx = .NOT. (context == "NONE") 1843 1766 1844 IF( llx ) THEN 1767 1845 #ifdef key_iomput 1768 IF( kt == kwrite ) THEN 1769 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1770 CALL xios_send_field(trim(cdvar), pvar) 1771 ENDIF 1846 IF( kt == kwrite ) THEN 1847 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1848 CALL iom_swap(context) 1849 CALL iom_put(trim(cdvar), pvar) 1850 CALL iom_swap(cxios_context) 1851 ELSE 1852 IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D)',trim(cdvar) 1853 CALL iom_swap(context) 1854 CALL iom_set_rstw_active( trim(cdvar), rs3 = pvar ) 1855 CALL iom_swap(cxios_context) 1856 ENDIF 1772 1857 #endif 1773 1858 ELSE … … 1781 1866 END SUBROUTINE iom_rp3d_sp 1782 1867 1783 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1868 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1784 1869 INTEGER , INTENT(in) :: kt ! ocean time-step 1785 1870 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1788 1873 REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1789 1874 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1790 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1791 LOGICAL :: llx ! local xios write flag 1792 INTEGER :: ivid ! variable id 1793 1794 llx = .FALSE. 1795 IF(PRESENT(ldxios)) llx = ldxios 1875 ! 1876 LOGICAL :: llx ! local xios write flag 1877 INTEGER :: ivid ! variable id 1878 CHARACTER(LEN=lc) :: context 1879 ! 1880 CALL set_xios_context(kiomid, context) 1881 1882 llx = .NOT. (context == "NONE") 1883 1796 1884 IF( llx ) THEN 1797 1885 #ifdef key_iomput 1798 IF( kt == kwrite ) THEN 1799 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1800 CALL xios_send_field(trim(cdvar), pvar) 1801 ENDIF 1886 IF( kt == kwrite ) THEN 1887 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1888 CALL iom_swap(context) 1889 CALL iom_put(trim(cdvar), pvar) 1890 CALL iom_swap(cxios_context) 1891 ELSE 1892 IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D)',trim(cdvar) 1893 CALL iom_swap(context) 1894 CALL iom_set_rstw_active( trim(cdvar), rd3 = pvar ) 1895 CALL iom_swap(cxios_context) 1896 ENDIF 1802 1897 #endif 1803 1898 ELSE … … 2145 2240 CALL iom_swap( cdname ) ! swap to cdname context 2146 2241 CALL xios_update_calendar(kt) 2147 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context)) ! return back to nemo context2242 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( cxios_context ) ! return back to nemo context 2148 2243 END SUBROUTINE iom_setkt 2149 2244 … … 2159 2254 CALL iom_swap( cdname ) ! swap to cdname context 2160 2255 CALL xios_context_finalize() ! finalize the context 2161 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context)) ! return back to nemo context2256 IF( cdname /= cxios_context ) CALL iom_swap( cxios_context ) ! return back to nemo context 2162 2257 ENDIF 2163 2258 !
Note: See TracChangeset
for help on using the changeset viewer.
