- Timestamp:
- 2020-12-02T18:22:24+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/IOM/iom.F90 (modified) (59 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette@13 559sette10 ^/utils/CI/sette@13795 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/IOM/iom.F90
r13998 r14018 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. ) … … 200 216 ! vertical grid definition 201 217 IF(.NOT.llrst_context) THEN 202 203 204 205 218 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 219 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 220 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 221 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 206 222 CALL iom_set_axis_attr( "depthf", paxis = gdept_1d ) 207 223 208 224 ! ABL 209 210 211 212 213 214 215 225 IF( .NOT. ALLOCATED(ght_abl) ) THEN ! force definition for xml files (xios) 226 ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) ) ! default allocation needed by iom 227 ght_abl(:) = -1._wp ; ghw_abl(:) = -1._wp 228 e3t_abl(:) = -1._wp ; e3w_abl(:) = -1._wp 229 ENDIF 230 CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 231 CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 216 232 217 218 219 220 221 222 223 224 225 226 227 233 ! Add vertical grid bounds 234 zt_bnds(2,: ) = gdept_1d(:) 235 zt_bnds(1,2:jpk ) = gdept_1d(1:jpkm1) 236 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 237 zw_bnds(1,: ) = gdepw_1d(:) 238 zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 239 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 240 CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 241 CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) 242 CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 243 CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 228 244 CALL iom_set_axis_attr( "depthf", bounds=zw_bnds ) 229 245 230 231 232 233 234 235 236 237 238 246 ! ABL 247 za_bnds(1,:) = ghw_abl(1:jpkam1) 248 za_bnds(2,:) = ghw_abl(2:jpka ) 249 CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds ) 250 za_bnds(1,:) = ght_abl(2:jpka ) 251 za_bnds(2,:) = ght_abl(2:jpka ) + e3w_abl(2:jpka) 252 CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 253 254 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 239 255 # if defined key_si3 240 241 242 256 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 257 ! SIMIP diagnostics (4 main arctic straits) 258 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 243 259 # endif 244 260 #if defined key_top 245 246 #endif 247 248 249 250 251 252 253 254 261 IF( ALLOCATED(profsed) ) CALL iom_set_axis_attr( "profsed", paxis = profsed ) 262 #endif 263 CALL iom_set_axis_attr( "icbcla", class_num ) 264 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) ! strange syntaxe and idea... 265 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) ) ! strange syntaxe and idea... 266 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea... 267 ! for diaprt, we need to define an axis which size can be 1 (default) or 5 (if the file subbasins.nc exists) 268 INQUIRE( FILE = 'subbasins.nc', EXIST = ll_exist ) 269 nbasin = 1 + 4 * COUNT( (/ll_exist/) ) 270 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,nbasin) /) ) 255 271 ENDIF 256 272 ! 257 273 ! automatic definitions of some of the xml attributs 258 IF( TRIM(cdname) == TRIM(crxios_context) ) THEN 259 !set names of the fields in restart file IF using XIOS to read data 260 CALL iom_set_rst_context(.TRUE.) 261 CALL iom_set_rst_vars(rst_rfields) 262 !set which fields are to be read from restart file 263 CALL iom_set_rstr_active() 264 ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 265 !set names of the fields in restart file IF using XIOS to write data 266 CALL iom_set_rst_context(.FALSE.) 267 CALL iom_set_rst_vars(rst_wfields) 268 !set which fields are to be written to a restart file 269 CALL iom_set_rstw_active(fname) 274 IF(llrstr) THEN 275 IF(PRESENT(kdid)) THEN 276 CALL iom_set_rst_context(.TRUE.) 277 !set which fields will be read from restart file 278 CALL iom_set_vars_active(kdid) 279 ELSE 280 CALL ctl_stop( 'iom_init:', 'restart read with XIOS: missing pointer to NETCDF file' ) 281 ENDIF 282 ELSE IF(llrstw) THEN 283 CALL iom_set_rstw_file(iom_file(kdid)%name) 270 284 ELSE 271 285 CALL set_xmlatt 272 286 ENDIF 273 287 ! … … 285 299 END SUBROUTINE iom_init 286 300 287 SUBROUTINE iom_init_closedef 301 SUBROUTINE iom_init_closedef(cdname) 288 302 !!---------------------------------------------------------------------- 289 303 !! *** SUBROUTINE iom_init_closedef *** … … 293 307 !! 294 308 !!---------------------------------------------------------------------- 295 309 CHARACTER(len=*), OPTIONAL, INTENT(IN) :: cdname 296 310 #if defined key_iomput 297 CALL xios_close_context_definition() 298 CALL xios_update_calendar( 0 ) 311 LOGICAL :: llrstw 312 313 llrstw = .FALSE. 314 IF(PRESENT(cdname)) THEN 315 llrstw = (cdname == cw_ocerst_cxt) 316 llrstw = llrstw .OR. (cdname == cw_icerst_cxt) 317 llrstw = llrstw .OR. (cdname == cw_toprst_cxt) 318 llrstw = llrstw .OR. (cdname == cw_sedrst_cxt) 319 ENDIF 320 321 IF( llrstw ) THEN 322 !set names of the fields in restart file IF using XIOS to write data 323 CALL iom_set_rst_context(.FALSE.) 324 CALL xios_close_context_definition() 325 ELSE 326 CALL xios_close_context_definition() 327 CALL xios_update_calendar( 0 ) 328 ENDIF 299 329 #else 300 330 IF( .FALSE. ) WRITE(numout,*) 'iom_init_closedef: should not see this' ! useless statement to avoid compilation warnings … … 303 333 END SUBROUTINE iom_init_closedef 304 334 305 SUBROUTINE iom_set_ rstw_var_active(field)335 SUBROUTINE iom_set_vars_active(idnum) 306 336 !!--------------------------------------------------------------------- 307 !! *** SUBROUTINE iom_set_rstw_var_active *** 308 !! 309 !! ** Purpose : enable variable in restart file when writing with XIOS 337 !! *** SUBROUTINE iom_set_vars_active *** 338 !! 339 !! ** Purpose : define filename in XIOS context for reading file, 340 !! enable variables present in a file for reading with XIOS 341 !! id of the file is assumed to be rrestart. 310 342 !!--------------------------------------------------------------------- 311 CHARACTER(len = *), INTENT(IN) :: field 312 INTEGER :: i 313 LOGICAL :: llis_set 314 CHARACTER(LEN=256) :: clinfo ! info character 315 343 INTEGER, INTENT(IN) :: idnum 344 316 345 #if defined key_iomput 317 llis_set = .FALSE. 318 319 DO i = 1, max_rst_fields 320 IF(TRIM(rst_wfields(i)%vname) == field) THEN 321 rst_wfields(i)%active = .TRUE. 322 llis_set = .TRUE. 323 EXIT 324 ENDIF 325 ENDDO 326 !Warn if variable is not in defined in rst_wfields 327 IF(.NOT.llis_set) THEN 328 WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 329 CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 ) 330 ENDIF 331 #else 332 clinfo = 'iom_set_rstw_var_active: key_iomput is needed to use XIOS restart read/write functionality' 333 CALL ctl_stop('STOP', TRIM(clinfo)) 334 #endif 335 336 END SUBROUTINE iom_set_rstw_var_active 337 338 SUBROUTINE iom_set_rstr_active() 346 INTEGER :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims 347 TYPE(xios_field) :: field_hdl 348 TYPE(xios_file) :: file_hdl 349 TYPE(xios_filegroup) :: filegroup_hdl 350 INTEGER :: dimids(4), jv,i, idim 351 CHARACTER(LEN=256) :: clinfo ! info character 352 INTEGER, ALLOCATABLE :: indimlens(:) 353 CHARACTER(LEN=nf90_max_name), ALLOCATABLE :: indimnames(:) 354 CHARACTER(LEN=nf90_max_name) :: dimname, varname 355 INTEGER :: iln 356 CHARACTER(LEN=lc) :: fname 357 LOGICAL :: lmeta 358 !metadata in restart file for restart read with XIOS 359 INTEGER, PARAMETER :: NMETA = 10 360 CHARACTER(LEN=lc) :: meta(NMETA) 361 362 363 meta(1) = "nav_lat" 364 meta(2) = "nav_lon" 365 meta(3) = "nav_lev" 366 meta(4) = "time_instant" 367 meta(5) = "time_instant_bounds" 368 meta(6) = "time_counter" 369 meta(7) = "time_counter_bounds" 370 meta(8) = "x" 371 meta(9) = "y" 372 meta(10) = "numcat" 373 374 clinfo = ' iom_set_vars_active, file: '//TRIM(iom_file(idnum)%name) 375 376 iln = INDEX( iom_file(idnum)%name, '.nc' ) 377 !XIOS doee not need .nc 378 IF(iln > 0) THEN 379 fname = iom_file(idnum)%name(1:iln-1) 380 ELSE 381 fname = iom_file(idnum)%name 382 ENDIF 383 384 !set name of the restart file and enable available fields 385 CALL xios_get_handle("file_definition", filegroup_hdl ) 386 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 387 CALL xios_set_file_attr( "rrestart", name=fname, type="one_file", & 388 par_access="collective", enabled=.TRUE., mode="read", & 389 output_freq=xios_timestep ) 390 391 CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, ndims, nvars, natts ), clinfo ) 392 ALLOCATE(indimlens(ndims), indimnames(ndims)) 393 CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, unlimitedDimId = unlimitedDimId ), clinfo ) 394 395 DO idim = 1, ndims 396 CALL iom_nf90_check( nf90_inquire_dimension(iom_file(idnum)%nfid, idim, dimname, dimlen ), clinfo ) 397 indimlens(idim) = dimlen 398 indimnames(idim) = dimname 399 ENDDO 400 401 DO jv =1, nvars 402 lmeta = .FALSE. 403 CALL iom_nf90_check( nf90_inquire_variable(iom_file(idnum)%nfid, jv, varname, xtype, ndims, dimids, natts ), clinfo ) 404 DO i = 1, NMETA 405 IF(varname == meta(i)) THEN 406 lmeta = .TRUE. 407 ENDIF 408 ENDDO 409 IF(.NOT.lmeta) THEN 410 CALL xios_add_child(file_hdl, field_hdl, varname) 411 mdims = ndims 412 413 IF(ANY(dimids(1:ndims) == unlimitedDimId)) THEN 414 mdims = mdims - 1 415 ENDIF 416 417 IF(mdims == 3) THEN 418 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 419 domain_ref="grid_N", & 420 axis_ref=iom_axis(indimlens(dimids(mdims))), & 421 prec = 8, operation = "instant" ) 422 ELSEIF(mdims == 2) THEN 423 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 424 domain_ref="grid_N", prec = 8, & 425 operation = "instant" ) 426 ELSEIF(mdims == 1) THEN 427 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 428 axis_ref=iom_axis(indimlens(dimids(mdims))), & 429 prec = 8, operation = "instant" ) 430 ELSEIF(mdims == 0) THEN 431 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 432 scalar_ref = "grid_scalar", prec = 8, & 433 operation = "instant" ) 434 ELSE 435 WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 436 CALL ctl_stop( 'iom_set_vars_active:', ctmp1 ) 437 ENDIF 438 ENDIF 439 ENDDO 440 DEALLOCATE(indimlens, indimnames) 441 #endif 442 END SUBROUTINE iom_set_vars_active 443 444 SUBROUTINE iom_set_rstw_file(cdrst_file) 339 445 !!--------------------------------------------------------------------- 340 !! *** SUBROUTINE iom_set_rstr_active *** 341 !! 342 !! ** Purpose : define file name in XIOS context for reading restart file, 343 !! enable variables present in restart file for reading with XIOS 446 !! *** SUBROUTINE iom_set_rstw_file *** 447 !! 448 !! ** Purpose : define file name in XIOS context for writing restart 344 449 !!--------------------------------------------------------------------- 345 346 !sets enabled = .TRUE. for each field in restart file 347 CHARACTER(len=256) :: rst_file 348 450 CHARACTER(len=*) :: cdrst_file 349 451 #if defined key_iomput 350 TYPE(xios_field) :: field_hdl 351 TYPE(xios_file) :: file_hdl 352 TYPE(xios_filegroup) :: filegroup_hdl 353 INTEGER :: i 354 CHARACTER(lc) :: clpath 355 356 clpath = TRIM(cn_ocerst_indir) 357 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 358 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 359 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 360 ELSE 361 rst_file = TRIM(clpath)//TRIM(Agrif_CFixed())//'_'//TRIM(cn_ocerst_in) 362 ENDIF 452 TYPE(xios_file) :: file_hdl 453 TYPE(xios_filegroup) :: filegroup_hdl 454 363 455 !set name of the restart file and enable available fields 364 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file 365 CALL xios_get_handle("file_definition", filegroup_hdl ) 366 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 367 CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", & 368 par_access="collective", enabled=.TRUE., mode="read", & 369 output_freq=xios_timestep) 370 !define variables for restart context 371 DO i = 1, max_rst_fields 372 IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN 373 IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 374 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname)) 375 SELECT CASE (TRIM(rst_rfields(i)%grid)) 376 CASE ("grid_N_3D") 377 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 378 domain_ref="grid_N", axis_ref="nav_lev", operation = "instant") 379 CASE ("grid_N") 380 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 381 domain_ref="grid_N", operation = "instant") 382 CASE ("grid_vector") 383 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 384 axis_ref="nav_lev", operation = "instant") 385 CASE ("grid_scalar") 386 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 387 scalar_ref = "grid_scalar", operation = "instant") 388 END SELECT 389 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file) 390 ENDIF 391 ENDIF 392 END DO 393 #endif 394 END SUBROUTINE iom_set_rstr_active 395 396 SUBROUTINE iom_set_rstw_core(cdmdl) 397 !!--------------------------------------------------------------------- 398 !! *** SUBROUTINE iom_set_rstw_core *** 399 !! 400 !! ** Purpose : set variables which are always in restart file 401 !!--------------------------------------------------------------------- 402 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS 403 CHARACTER(LEN=256) :: clinfo ! info character 404 #if defined key_iomput 405 IF(cdmdl == "OPA") THEN 406 !from restart.F90 407 CALL iom_set_rstw_var_active("rn_Dt") 408 IF ( .NOT. ln_diurnal_only ) THEN 409 CALL iom_set_rstw_var_active('ub' ) 410 CALL iom_set_rstw_var_active('vb' ) 411 CALL iom_set_rstw_var_active('tb' ) 412 CALL iom_set_rstw_var_active('sb' ) 413 CALL iom_set_rstw_var_active('sshb') 414 ! 415 CALL iom_set_rstw_var_active('un' ) 416 CALL iom_set_rstw_var_active('vn' ) 417 CALL iom_set_rstw_var_active('tn' ) 418 CALL iom_set_rstw_var_active('sn' ) 419 CALL iom_set_rstw_var_active('sshn') 420 CALL iom_set_rstw_var_active('rhop') 421 ENDIF 422 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 423 !from trasbc.F90 424 CALL iom_set_rstw_var_active('sbc_hc_b') 425 CALL iom_set_rstw_var_active('sbc_sc_b') 426 ENDIF 427 #else 428 clinfo = 'iom_set_rstw_core: key_iomput is needed to use XIOS restart read/write functionality' 429 CALL ctl_stop('STOP', TRIM(clinfo)) 430 #endif 431 END SUBROUTINE iom_set_rstw_core 432 433 SUBROUTINE iom_set_rst_vars(fields) 434 !!--------------------------------------------------------------------- 435 !! *** SUBROUTINE iom_set_rst_vars *** 436 !! 437 !! ** Purpose : Fill array fields with the information about all 438 !! possible variables and corresponding grids definition 439 !! for reading/writing restart with XIOS 440 !!--------------------------------------------------------------------- 441 TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields) 442 INTEGER :: i 443 444 i = 0 445 i = i + 1; fields(i)%vname="rn_Dt"; fields(i)%grid="grid_scalar" 446 i = i + 1; fields(i)%vname="un"; fields(i)%grid="grid_N_3D" 447 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D" 448 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D" 449 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D" 450 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D" 451 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D" 452 i = i + 1; fields(i)%vname="sn"; fields(i)%grid="grid_N_3D" 453 i = i + 1; fields(i)%vname="sb"; fields(i)%grid="grid_N_3D" 454 i = i + 1; fields(i)%vname="sshn"; fields(i)%grid="grid_N" 455 i = i + 1; fields(i)%vname="sshb"; fields(i)%grid="grid_N" 456 i = i + 1; fields(i)%vname="rhop"; fields(i)%grid="grid_N_3D" 457 i = i + 1; fields(i)%vname="kt"; fields(i)%grid="grid_scalar" 458 i = i + 1; fields(i)%vname="ndastp"; fields(i)%grid="grid_scalar" 459 i = i + 1; fields(i)%vname="adatrj"; fields(i)%grid="grid_scalar" 460 i = i + 1; fields(i)%vname="utau_b"; fields(i)%grid="grid_N" 461 i = i + 1; fields(i)%vname="vtau_b"; fields(i)%grid="grid_N" 462 i = i + 1; fields(i)%vname="qns_b"; fields(i)%grid="grid_N" 463 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N" 464 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N" 465 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D" 466 i = i + 1; fields(i)%vname="avt_k"; fields(i)%grid="grid_N_3D" 467 i = i + 1; fields(i)%vname="avm_k"; fields(i)%grid="grid_N_3D" 468 i = i + 1; fields(i)%vname="dissl"; fields(i)%grid="grid_N_3D" 469 i = i + 1; fields(i)%vname="sbc_hc_b"; fields(i)%grid="grid_N" 470 i = i + 1; fields(i)%vname="sbc_sc_b"; fields(i)%grid="grid_N" 471 i = i + 1; fields(i)%vname="qsr_hc_b"; fields(i)%grid="grid_N_3D" 472 i = i + 1; fields(i)%vname="fraqsr_1lev"; fields(i)%grid="grid_N" 473 i = i + 1; fields(i)%vname="greenland_icesheet_mass" 474 fields(i)%grid="grid_scalar" 475 i = i + 1; fields(i)%vname="greenland_icesheet_timelapsed" 476 fields(i)%grid="grid_scalar" 477 i = i + 1; fields(i)%vname="greenland_icesheet_mass_roc" 478 fields(i)%grid="grid_scalar" 479 i = i + 1; fields(i)%vname="antarctica_icesheet_mass" 480 fields(i)%grid="grid_scalar" 481 i = i + 1; fields(i)%vname="antarctica_icesheet_timelapsed" 482 fields(i)%grid="grid_scalar" 483 i = i + 1; fields(i)%vname="antarctica_icesheet_mass_roc" 484 fields(i)%grid="grid_scalar" 485 i = i + 1; fields(i)%vname="frc_v"; fields(i)%grid="grid_scalar" 486 i = i + 1; fields(i)%vname="frc_t"; fields(i)%grid="grid_scalar" 487 i = i + 1; fields(i)%vname="frc_s"; fields(i)%grid="grid_scalar" 488 i = i + 1; fields(i)%vname="frc_wn_t"; fields(i)%grid="grid_scalar" 489 i = i + 1; fields(i)%vname="frc_wn_s"; fields(i)%grid="grid_scalar" 490 i = i + 1; fields(i)%vname="ssh_ini"; fields(i)%grid="grid_N" 491 i = i + 1; fields(i)%vname="e3t_ini"; fields(i)%grid="grid_N_3D" 492 i = i + 1; fields(i)%vname="hc_loc_ini"; fields(i)%grid="grid_N_3D" 493 i = i + 1; fields(i)%vname="sc_loc_ini"; fields(i)%grid="grid_N_3D" 494 i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N" 495 i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N" 496 i = i + 1; fields(i)%vname="tilde_e3t_b"; fields(i)%grid="grid_N" 497 i = i + 1; fields(i)%vname="tilde_e3t_n"; fields(i)%grid="grid_N" 498 i = i + 1; fields(i)%vname="hdiv_lf"; fields(i)%grid="grid_N" 499 i = i + 1; fields(i)%vname="ub2_b"; fields(i)%grid="grid_N" 500 i = i + 1; fields(i)%vname="vb2_b"; fields(i)%grid="grid_N" 501 i = i + 1; fields(i)%vname="sshbb_e"; fields(i)%grid="grid_N" 502 i = i + 1; fields(i)%vname="ubb_e"; fields(i)%grid="grid_N" 503 i = i + 1; fields(i)%vname="vbb_e"; fields(i)%grid="grid_N" 504 i = i + 1; fields(i)%vname="sshb_e"; fields(i)%grid="grid_N" 505 i = i + 1; fields(i)%vname="ub_e"; fields(i)%grid="grid_N" 506 i = i + 1; fields(i)%vname="vb_e"; fields(i)%grid="grid_N" 507 i = i + 1; fields(i)%vname="fwf_isf_b"; fields(i)%grid="grid_N" 508 i = i + 1; fields(i)%vname="isf_sc_b"; fields(i)%grid="grid_N" 509 i = i + 1; fields(i)%vname="isf_hc_b"; fields(i)%grid="grid_N" 510 i = i + 1; fields(i)%vname="ssh_ibb"; fields(i)%grid="grid_N" 511 i = i + 1; fields(i)%vname="rnf_b"; fields(i)%grid="grid_N" 512 i = i + 1; fields(i)%vname="rnf_hc_b"; fields(i)%grid="grid_N" 513 i = i + 1; fields(i)%vname="rnf_sc_b"; fields(i)%grid="grid_N" 514 i = i + 1; fields(i)%vname="nn_fsbc"; fields(i)%grid="grid_scalar" 515 i = i + 1; fields(i)%vname="ssu_m"; fields(i)%grid="grid_N" 516 i = i + 1; fields(i)%vname="ssv_m"; fields(i)%grid="grid_N" 517 i = i + 1; fields(i)%vname="sst_m"; fields(i)%grid="grid_N" 518 i = i + 1; fields(i)%vname="sss_m"; fields(i)%grid="grid_N" 519 i = i + 1; fields(i)%vname="ssh_m"; fields(i)%grid="grid_N" 520 i = i + 1; fields(i)%vname="e3t_m"; fields(i)%grid="grid_N" 521 i = i + 1; fields(i)%vname="frq_m"; fields(i)%grid="grid_N" 522 i = i + 1; fields(i)%vname="avmb"; fields(i)%grid="grid_vector" 523 i = i + 1; fields(i)%vname="avtb"; fields(i)%grid="grid_vector" 524 i = i + 1; fields(i)%vname="ub2_i_b"; fields(i)%grid="grid_N" 525 i = i + 1; fields(i)%vname="vb2_i_b"; fields(i)%grid="grid_N" 526 i = i + 1; fields(i)%vname="ntime"; fields(i)%grid="grid_scalar" 527 i = i + 1; fields(i)%vname="Dsst"; fields(i)%grid="grid_scalar" 528 i = i + 1; fields(i)%vname="tmask"; fields(i)%grid="grid_N_3D" 529 i = i + 1; fields(i)%vname="umask"; fields(i)%grid="grid_N_3D" 530 i = i + 1; fields(i)%vname="vmask"; fields(i)%grid="grid_N_3D" 531 i = i + 1; fields(i)%vname="smask"; fields(i)%grid="grid_N_3D" 532 i = i + 1; fields(i)%vname="gdepw_n"; fields(i)%grid="grid_N_3D" 533 i = i + 1; fields(i)%vname="e3t_n"; fields(i)%grid="grid_N_3D" 534 i = i + 1; fields(i)%vname="e3u_n"; fields(i)%grid="grid_N_3D" 535 i = i + 1; fields(i)%vname="e3v_n"; fields(i)%grid="grid_N_3D" 536 i = i + 1; fields(i)%vname="surf_ini"; fields(i)%grid="grid_N" 537 i = i + 1; fields(i)%vname="e3t_b"; fields(i)%grid="grid_N_3D" 538 i = i + 1; fields(i)%vname="hmxl_n"; fields(i)%grid="grid_N_3D" 539 i = i + 1; fields(i)%vname="un_bf"; fields(i)%grid="grid_N" 540 i = i + 1; fields(i)%vname="vn_bf"; fields(i)%grid="grid_N" 541 i = i + 1; fields(i)%vname="hbl"; fields(i)%grid="grid_N" 542 i = i + 1; fields(i)%vname="hbli"; fields(i)%grid="grid_N" 543 i = i + 1; fields(i)%vname="wn"; fields(i)%grid="grid_N_3D" 544 545 IF( i-1 > max_rst_fields) THEN 546 WRITE(ctmp1,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small' 547 CALL ctl_stop( 'iom_set_rst_vars:', ctmp1 ) 548 ENDIF 549 END SUBROUTINE iom_set_rst_vars 550 551 552 SUBROUTINE iom_set_rstw_active(cdrst_file) 456 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ', TRIM(cdrst_file) 457 CALL xios_get_handle("file_definition", filegroup_hdl ) 458 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 459 IF(nxioso.eq.1) THEN 460 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 461 mode="write", output_freq=xios_timestep) 462 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 463 ELSE 464 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 465 mode="write", output_freq=xios_timestep) 466 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 467 ENDIF 468 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 469 #endif 470 END SUBROUTINE iom_set_rstw_file 471 472 473 SUBROUTINE iom_set_rstw_active(sdfield, rd0, rs0, rd1, rs1, rd2, rs2, rd3, rs3) 553 474 !!--------------------------------------------------------------------- 554 475 !! *** SUBROUTINE iom_set_rstw_active *** … … 558 479 !!--------------------------------------------------------------------- 559 480 !sets enabled = .TRUE. for each field in restart file 560 CHARACTER(len=*) :: cdrst_file 481 CHARACTER(len = *), INTENT(IN) :: sdfield 482 REAL(dp), OPTIONAL, INTENT(IN) :: rd0 483 REAL(sp), OPTIONAL, INTENT(IN) :: rs0 484 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rd1 485 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rs1 486 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rd2 487 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rs2 488 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3 489 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rs3 561 490 #if defined key_iomput 562 TYPE(xios_field) :: field_hdl 563 TYPE(xios_file) :: file_hdl 564 TYPE(xios_filegroup) :: filegroup_hdl 565 INTEGER :: i 566 CHARACTER(lc) :: clpath 567 568 !set name of the restart file and enable available fields 569 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file 570 CALL xios_get_handle("file_definition", filegroup_hdl ) 571 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 572 IF(nxioso.eq.1) THEN 573 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 574 mode="write", output_freq=xios_timestep) 575 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 576 ELSE 577 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 578 mode="write", output_freq=xios_timestep) 579 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 580 ENDIF 581 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 491 TYPE(xios_field) :: field_hdl 492 TYPE(xios_file) :: file_hdl 493 494 CALL xios_get_handle("wrestart", file_hdl) 582 495 !define fields for restart context 583 DO i = 1, max_rst_fields 584 IF( rst_wfields(i)%active ) THEN 585 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname)) 586 SELECT CASE (TRIM(rst_wfields(i)%grid)) 587 CASE ("grid_N_3D") 588 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 589 domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant") 590 CASE ("grid_N") 591 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 592 domain_ref="grid_N", prec = 8, operation = "instant") 593 CASE ("grid_vector") 594 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 595 axis_ref="nav_lev", prec = 8, operation = "instant") 596 CASE ("grid_scalar") 597 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 598 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 599 END SELECT 600 ENDIF 601 END DO 496 CALL xios_add_child(file_hdl, field_hdl, sdfield) 497 498 IF(PRESENT(rd3)) 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 = 8, operation = "instant" ) 503 ELSEIF(PRESENT(rs3)) THEN 504 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 505 domain_ref = "grid_N", & 506 axis_ref = iom_axis(size(rd3, 3)), & 507 prec = 4, operation = "instant" ) 508 ELSEIF(PRESENT(rd2)) THEN 509 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 510 domain_ref = "grid_N", prec = 8, & 511 operation = "instant" ) 512 ELSEIF(PRESENT(rs2)) THEN 513 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 514 domain_ref = "grid_N", prec = 4, & 515 operation = "instant" ) 516 ELSEIF(PRESENT(rd1)) THEN 517 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 518 axis_ref = iom_axis(size(rd1, 1)), & 519 prec = 8, operation = "instant" ) 520 ELSEIF(PRESENT(rs1)) THEN 521 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 522 axis_ref = iom_axis(size(rd1, 1)), & 523 prec = 4, operation = "instant" ) 524 ELSEIF(PRESENT(rd0)) THEN 525 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 526 scalar_ref = "grid_scalar", prec = 8, & 527 operation = "instant" ) 528 ELSEIF(PRESENT(rs0)) THEN 529 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 530 scalar_ref = "grid_scalar", prec = 4, & 531 operation = "instant" ) 532 ENDIF 602 533 #endif 603 534 END SUBROUTINE iom_set_rstw_active 604 535 536 FUNCTION iom_axis(idlev) result(axis_ref) 537 !!--------------------------------------------------------------------- 538 !! *** FUNCTION iom_axis *** 539 !! 540 !! ** Purpose : Used for grid definition when XIOS is used to read/write 541 !! restart. Returns axis corresponding to the number of levels 542 !! given as an input variable. Axes are defined in routine 543 !! iom_set_rst_context 544 !!--------------------------------------------------------------------- 545 INTEGER, INTENT(IN) :: idlev 546 CHARACTER(len=lc) :: axis_ref 547 CHARACTER(len=12) :: str 548 IF(idlev == jpk) THEN 549 axis_ref="nav_lev" 550 #if defined key_si3 551 ELSEIF(idlev == jpl) THEN 552 axis_ref="numcat" 553 #endif 554 ELSE 555 write(str, *) idlev 556 CALL ctl_stop( 'iom_axis', 'Definition for axis with '//TRIM(ADJUSTL(str))//' levels missing') 557 ENDIF 558 END FUNCTION iom_axis 559 560 FUNCTION iom_xios_setid(cdname) result(kid) 561 !!--------------------------------------------------------------------- 562 !! *** FUNCTION *** 563 !! 564 !! ** Purpose : this function returns first available id to keep information about file 565 !! sets filename in iom_file structure and sets name 566 !! of XIOS context depending on cdcomp 567 !! corresponds to iom_nf90_open 568 !!--------------------------------------------------------------------- 569 CHARACTER(len=*), INTENT(in ) :: cdname ! File name 570 INTEGER :: kid ! identifier of the opened file 571 INTEGER :: jl 572 573 kid = 0 574 DO jl = jpmax_files, 1, -1 575 IF( iom_file(jl)%nfid == 0 ) kid = jl 576 ENDDO 577 578 iom_file(kid)%name = TRIM(cdname) 579 iom_file(kid)%nfid = 1 580 iom_file(kid)%nvars = 0 581 iom_file(kid)%irec = -1 582 583 END FUNCTION iom_xios_setid 584 605 585 SUBROUTINE iom_set_rst_context(ld_rstr) 606 !!---------------------------------------------------------------------586 !!--------------------------------------------------------------------- 607 587 !! *** SUBROUTINE iom_set_rst_context *** 608 588 !! … … 611 591 !! 612 592 !!--------------------------------------------------------------------- 613 LOGICAL, INTENT(IN) :: ld_rstr 614 !ld_rstr is true for restart context. There is no need to define grid for 615 !restart read, because it's read from file 593 LOGICAL, INTENT(IN) :: ld_rstr 594 INTEGER :: ji 616 595 #if defined key_iomput 617 TYPE(xios_domaingroup) :: domaingroup_hdl618 TYPE(xios_domain) :: domain_hdl619 TYPE(xios_axisgroup) :: axisgroup_hdl620 TYPE(xios_axis) :: axis_hdl621 TYPE(xios_scalar) :: scalar_hdl622 TYPE(xios_scalargroup) :: scalargroup_hdl623 624 CALL xios_get_handle("domain_definition",domaingroup_hdl)625 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")626 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr)596 TYPE(xios_domaingroup) :: domaingroup_hdl 597 TYPE(xios_domain) :: domain_hdl 598 TYPE(xios_axisgroup) :: axisgroup_hdl 599 TYPE(xios_axis) :: axis_hdl 600 TYPE(xios_scalar) :: scalar_hdl 601 TYPE(xios_scalargroup) :: scalargroup_hdl 602 603 CALL xios_get_handle("domain_definition",domaingroup_hdl) 604 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 605 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 627 606 628 CALL xios_get_handle("axis_definition",axisgroup_hdl)629 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev")607 CALL xios_get_handle("axis_definition",axisgroup_hdl) 608 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 630 609 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 631 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 632 CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 633 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 634 635 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 636 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 610 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 611 CALL xios_set_axis_attr( "nav_lev", long_name = "Vertical levels in meters", positive = "down") 612 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 613 #if defined key_si3 614 CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat") 615 CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,wp), ji=1,jpl) /) ) 616 #endif 617 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 618 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 637 619 #endif 638 620 END SUBROUTINE iom_set_rst_context 621 622 623 SUBROUTINE set_xios_context(kdid, cdcont) 624 !!--------------------------------------------------------------------- 625 !! *** SUBROUTINE iom_set_rst_context *** 626 !! 627 !! ** Purpose : set correct XIOS context based on kdid 628 !! 629 !!--------------------------------------------------------------------- 630 INTEGER, INTENT(IN) :: kdid ! Identifier of the file 631 CHARACTER(LEN=lc), INTENT(OUT) :: cdcont ! name of the context for XIOS read/write 632 633 cdcont = "NONE" 634 635 IF(lrxios) THEN 636 IF(kdid == numror) THEN 637 cdcont = cr_ocerst_cxt 638 ELSEIF(kdid == numrir) THEN 639 cdcont = cr_icerst_cxt 640 ELSEIF(kdid == numrtr) THEN 641 cdcont = cr_toprst_cxt 642 ELSEIF(kdid == numrsr) THEN 643 cdcont = cr_sedrst_cxt 644 ENDIF 645 ENDIF 646 647 IF(lwxios) THEN 648 IF(kdid == numrow) THEN 649 cdcont = cw_ocerst_cxt 650 ELSEIF(kdid == numriw) THEN 651 cdcont = cw_icerst_cxt 652 ELSEIF(kdid == numrtw) THEN 653 cdcont = cw_toprst_cxt 654 ELSEIF(kdid == numrsw) THEN 655 cdcont = cw_sedrst_cxt 656 ENDIF 657 ENDIF 658 END SUBROUTINE set_xios_context 659 639 660 640 661 SUBROUTINE iom_swap( cdname ) … … 647 668 #if defined key_iomput 648 669 TYPE(xios_context) :: nemo_hdl 649 650 670 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 651 671 CALL xios_get_handle(TRIM(cdname),nemo_hdl) … … 897 917 !! INTERFACE iom_get 898 918 !!---------------------------------------------------------------------- 899 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime , ldxios)919 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime ) 900 920 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 901 921 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable … … 903 923 REAL(dp) :: ztmp_pvar ! tmp var to read field 904 924 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 905 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart906 925 ! 907 926 INTEGER :: idvar ! variable id … … 911 930 CHARACTER(LEN=100) :: clname ! file name 912 931 CHARACTER(LEN=1) :: cldmspc ! 913 LOGICAL :: llxios 914 ! 915 llxios = .FALSE. 916 IF( PRESENT(ldxios) ) llxios = ldxios 917 918 IF(.NOT.llxios) THEN ! read data using default library 932 CHARACTER(LEN=lc) :: context 933 ! 934 CALL set_xios_context(kiomid, context) 935 936 IF(context == "NONE") THEN ! read data using default library 919 937 itime = 1 920 938 IF( PRESENT(ktime) ) itime = ktime … … 939 957 #if defined key_iomput 940 958 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 941 CALL iom_swap( TRIM(crxios_context))959 CALL iom_swap(context) 942 960 CALL xios_recv_field( trim(cdvar), pvar) 943 CALL iom_swap( TRIM(cxios_context))961 CALL iom_swap(cxios_context) 944 962 #else 945 963 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 949 967 END SUBROUTINE iom_g0d_sp 950 968 951 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime , ldxios)969 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime ) 952 970 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 953 971 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 954 972 REAL(dp) , INTENT( out) :: pvar ! read field 955 973 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 956 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart957 974 ! 958 975 INTEGER :: idvar ! variable id … … 962 979 CHARACTER(LEN=100) :: clname ! file name 963 980 CHARACTER(LEN=1) :: cldmspc ! 964 LOGICAL :: llxios 965 ! 966 llxios = .FALSE. 967 IF( PRESENT(ldxios) ) llxios = ldxios 968 969 IF(.NOT.llxios) THEN ! read data using default library 981 CHARACTER(LEN=lc) :: context 982 ! 983 CALL set_xios_context(kiomid, context) 984 985 IF(context == "NONE") THEN ! read data using default library 970 986 itime = 1 971 987 IF( PRESENT(ktime) ) itime = ktime … … 989 1005 #if defined key_iomput 990 1006 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 991 CALL iom_swap( TRIM(crxios_context))1007 CALL iom_swap(context) 992 1008 CALL xios_recv_field( trim(cdvar), pvar) 993 CALL iom_swap( TRIM(cxios_context))1009 CALL iom_swap(cxios_context) 994 1010 #else 995 1011 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 999 1015 END SUBROUTINE iom_g0d_dp 1000 1016 1001 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)1017 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 1002 1018 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1003 1019 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1008 1024 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1009 1025 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1010 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1011 1026 ! 1012 1027 IF( kiomid > 0 ) THEN … … 1014 1029 ALLOCATE(ztmp_pvar(size(pvar,1))) 1015 1030 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=ztmp_pvar, & 1016 & ktime=ktime, kstart=kstart, kcount=kcount, & 1017 & ldxios=ldxios ) 1031 & ktime=ktime, kstart=kstart, kcount=kcount ) 1018 1032 pvar = ztmp_pvar 1019 1033 DEALLOCATE(ztmp_pvar) … … 1023 1037 1024 1038 1025 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)1039 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 1026 1040 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1027 1041 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1031 1045 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1032 1046 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1033 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1034 1047 ! 1035 1048 IF( kiomid > 0 ) THEN 1036 1049 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 1037 & ktime=ktime, kstart=kstart, kcount=kcount, & 1038 & ldxios=ldxios ) 1050 & ktime=ktime, kstart=kstart, kcount=kcount) 1039 1051 ENDIF 1040 1052 END SUBROUTINE iom_g1d_dp 1041 1053 1042 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1054 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount) 1043 1055 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1044 1056 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1052 1064 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1053 1065 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1054 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1055 1066 ! 1056 1067 IF( kiomid > 0 ) THEN … … 1059 1070 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = ztmp_pvar , ktime = ktime, & 1060 1071 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1061 & kstart = kstart , kcount = kcount , ldxios=ldxios)1072 & kstart = kstart , kcount = kcount ) 1062 1073 pvar = ztmp_pvar 1063 1074 DEALLOCATE(ztmp_pvar) … … 1066 1077 END SUBROUTINE iom_g2d_sp 1067 1078 1068 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1079 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount) 1069 1080 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1070 1081 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1077 1088 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1078 1089 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1079 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1080 1090 ! 1081 1091 IF( kiomid > 0 ) THEN 1082 1092 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = pvar , ktime = ktime, & 1083 1093 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1084 & kstart = kstart , kcount = kcount , ldxios=ldxios)1094 & kstart = kstart , kcount = kcount ) 1085 1095 ENDIF 1086 1096 END SUBROUTINE iom_g2d_dp 1087 1097 1088 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1098 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount ) 1089 1099 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1090 1100 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1098 1108 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1099 1109 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1100 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1101 1110 ! 1102 1111 IF( kiomid > 0 ) THEN … … 1105 1114 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = ztmp_pvar , ktime = ktime, & 1106 1115 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1107 & kstart = kstart , kcount = kcount , ldxios=ldxios)1116 & kstart = kstart , kcount = kcount ) 1108 1117 pvar = ztmp_pvar 1109 1118 DEALLOCATE(ztmp_pvar) … … 1112 1121 END SUBROUTINE iom_g3d_sp 1113 1122 1114 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1123 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount ) 1115 1124 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1116 1125 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1123 1132 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1124 1133 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1125 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1126 1134 ! 1127 1135 IF( kiomid > 0 ) THEN … … 1129 1137 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1130 1138 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1131 & kstart = kstart , kcount = kcount , ldxios=ldxios)1139 & kstart = kstart , kcount = kcount ) 1132 1140 END IF 1133 1141 ENDIF … … 1137 1145 1138 1146 SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime , & 1139 & cd_type, psgn, kfill, kstart, kcount , ldxios)1147 & cd_type, psgn, kfill, kstart, kcount ) 1140 1148 !!----------------------------------------------------------------------- 1141 1149 !! *** ROUTINE iom_get_123d *** … … 1157 1165 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1158 1166 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1159 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart1160 1167 ! 1161 1168 LOGICAL :: llok ! true if ok! 1162 LOGICAL :: llxios ! local definition for XIOS read1163 1169 INTEGER :: jl ! loop on number of dimension 1164 1170 INTEGER :: idom ! type of domain … … 1187 1193 REAL(dp) :: gma, gmi 1188 1194 !--------------------------------------------------------------------- 1189 ! 1195 CHARACTER(LEN=lc) :: context 1196 ! 1197 CALL set_xios_context(kiomid, context) 1190 1198 inlev = -1 1191 1199 IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3) 1192 1200 ! 1193 llxios = .FALSE.1194 IF( PRESENT(ldxios) ) llxios = ldxios1195 !1196 1201 idom = kdom 1197 1202 istop = nstop 1198 1203 ! 1199 IF( .NOT.llxios) THEN1204 IF(context == "NONE") THEN 1200 1205 clname = iom_file(kiomid)%name ! esier to read 1201 1206 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) … … 1364 1369 #if defined key_iomput 1365 1370 !would be good to be able to check which context is active and swap only if current is not restart 1366 CALL iom_swap( TRIM(crxios_context) ) 1371 idvar = iom_varid( kiomid, cdvar ) 1372 CALL iom_swap(context) 1373 zsgn = 1._wp 1374 IF( PRESENT(psgn ) ) zsgn = psgn 1375 cl_type = 'T' 1376 IF( PRESENT(cd_type) ) cl_type = cd_type 1377 1367 1378 IF( PRESENT(pv_r3d) ) THEN 1368 1379 IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 1369 CALL xios_recv_field( trim(cdvar), pv_r3d) 1370 IF(idom /= jpdom_unknown ) CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1380 CALL xios_recv_field( trim(cdvar), pv_r3d(:, :, :)) 1381 IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1382 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill) 1383 ENDIF 1371 1384 ELSEIF( PRESENT(pv_r2d) ) THEN 1372 1385 IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 1373 CALL xios_recv_field( trim(cdvar), pv_r2d) 1374 IF(idom /= jpdom_unknown ) CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1386 CALL xios_recv_field( trim(cdvar), pv_r2d(:, :)) 1387 IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1388 CALL lbc_lnk('iom', pv_r2d, cl_type, zsgn, kfillmode = kfill) 1389 ENDIF 1375 1390 ELSEIF( PRESENT(pv_r1d) ) THEN 1376 1391 IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 1377 1392 CALL xios_recv_field( trim(cdvar), pv_r1d) 1378 1393 ENDIF 1379 CALL iom_swap( TRIM(cxios_context))1394 CALL iom_swap(cxios_context) 1380 1395 #else 1381 1396 istop = istop + 1 … … 1392 1407 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1393 1408 IF( PRESENT(pv_r1d) ) THEN 1394 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf1395 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs1409 IF( zscf /= 1._wp ) pv_r1d(:) = pv_r1d(:) * zscf 1410 IF( zofs /= 0._wp ) pv_r1d(:) = pv_r1d(:) + zofs 1396 1411 ELSEIF( PRESENT(pv_r2d) ) THEN 1397 IF( zscf /= 1. ) pv_r2d(:,:) = pv_r2d(:,:) * zscf1398 IF( zofs /= 0. ) pv_r2d(:,:) = pv_r2d(:,:) + zofs1412 IF( zscf /= 1._wp) pv_r2d(:,:) = pv_r2d(:,:) * zscf 1413 IF( zofs /= 0._wp) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1399 1414 ELSEIF( PRESENT(pv_r3d) ) THEN 1400 IF( zscf /= 1. ) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf1401 IF( zofs /= 0. ) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs1415 IF( zscf /= 1._wp) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 1416 IF( zofs /= 0._wp) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 1402 1417 ENDIF 1403 1418 ! … … 1573 1588 !! INTERFACE iom_rstput 1574 1589 !!---------------------------------------------------------------------- 1575 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1590 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1576 1591 INTEGER , INTENT(in) :: kt ! ocean time-step 1577 1592 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1580 1595 REAL(sp) , INTENT(in) :: pvar ! written field 1581 1596 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1582 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1583 LOGICAL :: llx ! local xios write flag 1584 INTEGER :: ivid ! variable id 1585 1586 llx = .FALSE. 1587 IF(PRESENT(ldxios)) llx = ldxios 1597 ! 1598 LOGICAL :: llx ! local xios write flag 1599 INTEGER :: ivid ! variable id 1600 CHARACTER(LEN=lc) :: context 1601 ! 1602 CALL set_xios_context(kiomid, context) 1603 1604 llx = .NOT. (context == "NONE") 1605 1588 1606 IF( llx ) THEN 1589 1607 #ifdef key_iomput 1590 IF( kt == kwrite ) THEN 1591 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1592 CALL xios_send_field(trim(cdvar), pvar) 1593 ENDIF 1608 IF( kt == kwrite ) THEN 1609 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1610 CALL iom_swap(context) 1611 CALL iom_put(trim(cdvar), pvar) 1612 CALL iom_swap(cxios_context) 1613 ELSE 1614 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1615 CALL iom_swap(context) 1616 CALL iom_set_rstw_active( trim(cdvar), rs0 = pvar ) 1617 CALL iom_swap(cxios_context) 1618 ENDIF 1594 1619 #endif 1595 1620 ELSE … … 1603 1628 END SUBROUTINE iom_rp0d_sp 1604 1629 1605 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1630 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1606 1631 INTEGER , INTENT(in) :: kt ! ocean time-step 1607 1632 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1610 1635 REAL(dp) , INTENT(in) :: pvar ! written field 1611 1636 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1612 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1613 LOGICAL :: llx ! local xios write flag 1614 INTEGER :: ivid ! variable id 1615 1616 llx = .FALSE. 1617 IF(PRESENT(ldxios)) llx = ldxios 1637 ! 1638 LOGICAL :: llx ! local xios write flag 1639 INTEGER :: ivid ! variable id 1640 CHARACTER(LEN=lc) :: context 1641 ! 1642 CALL set_xios_context(kiomid, context) 1643 1644 llx = .NOT. (context == "NONE") 1645 1618 1646 IF( llx ) THEN 1619 1647 #ifdef key_iomput 1620 IF( kt == kwrite ) THEN 1621 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1622 CALL xios_send_field(trim(cdvar), pvar) 1623 ENDIF 1648 IF( kt == kwrite ) THEN 1649 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1650 CALL iom_swap(context) 1651 CALL iom_put(trim(cdvar), pvar) 1652 CALL iom_swap(cxios_context) 1653 ELSE 1654 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1655 CALL iom_swap(context) 1656 CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar ) 1657 CALL iom_swap(cxios_context) 1658 ENDIF 1624 1659 #endif 1625 1660 ELSE … … 1634 1669 1635 1670 1636 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1671 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1637 1672 INTEGER , INTENT(in) :: kt ! ocean time-step 1638 1673 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1641 1676 REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1642 1677 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1643 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1644 LOGICAL :: llx ! local xios write flag 1645 INTEGER :: ivid ! variable id 1646 1647 llx = .FALSE. 1648 IF(PRESENT(ldxios)) llx = ldxios 1678 ! 1679 LOGICAL :: llx ! local xios write flag 1680 INTEGER :: ivid ! variable id 1681 CHARACTER(LEN=lc) :: context 1682 ! 1683 CALL set_xios_context(kiomid, context) 1684 1685 llx = .NOT. (context == "NONE") 1686 1649 1687 IF( llx ) THEN 1650 1688 #ifdef key_iomput 1651 IF( kt == kwrite ) THEN 1652 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1653 CALL xios_send_field(trim(cdvar), pvar) 1654 ENDIF 1689 IF( kt == kwrite ) THEN 1690 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1691 CALL iom_swap(context) 1692 CALL iom_put(trim(cdvar), pvar) 1693 CALL iom_swap(cxios_context) 1694 ELSE 1695 IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D)',trim(cdvar) 1696 CALL iom_swap(context) 1697 CALL iom_set_rstw_active( trim(cdvar), rs1 = pvar ) 1698 CALL iom_swap(cxios_context) 1699 ENDIF 1655 1700 #endif 1656 1701 ELSE … … 1664 1709 END SUBROUTINE iom_rp1d_sp 1665 1710 1666 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1711 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1667 1712 INTEGER , INTENT(in) :: kt ! ocean time-step 1668 1713 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1671 1716 REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1672 1717 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1673 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1674 LOGICAL :: llx ! local xios write flag 1675 INTEGER :: ivid ! variable id 1676 1677 llx = .FALSE. 1678 IF(PRESENT(ldxios)) llx = ldxios 1718 ! 1719 LOGICAL :: llx ! local xios write flag 1720 INTEGER :: ivid ! variable id 1721 CHARACTER(LEN=lc) :: context 1722 ! 1723 CALL set_xios_context(kiomid, context) 1724 1725 llx = .NOT. (context == "NONE") 1726 1679 1727 IF( llx ) THEN 1680 1728 #ifdef key_iomput 1681 IF( kt == kwrite ) THEN 1682 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1683 CALL xios_send_field(trim(cdvar), pvar) 1684 ENDIF 1729 IF( kt == kwrite ) THEN 1730 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1731 CALL iom_swap(context) 1732 CALL iom_put(trim(cdvar), pvar) 1733 CALL iom_swap(cxios_context) 1734 ELSE 1735 IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D)',trim(cdvar) 1736 CALL iom_swap(context) 1737 CALL iom_set_rstw_active( trim(cdvar), rd1 = pvar ) 1738 CALL iom_swap(cxios_context) 1739 ENDIF 1685 1740 #endif 1686 1741 ELSE … … 1695 1750 1696 1751 1697 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1752 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1698 1753 INTEGER , INTENT(in) :: kt ! ocean time-step 1699 1754 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1702 1757 REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1703 1758 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1704 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1705 LOGICAL :: llx 1706 INTEGER :: ivid ! variable id 1707 1708 llx = .FALSE. 1709 IF(PRESENT(ldxios)) llx = ldxios 1759 ! 1760 LOGICAL :: llx 1761 INTEGER :: ivid ! variable id 1762 CHARACTER(LEN=lc) :: context 1763 ! 1764 CALL set_xios_context(kiomid, context) 1765 1766 llx = .NOT. (context == "NONE") 1767 1710 1768 IF( llx ) THEN 1711 1769 #ifdef key_iomput 1712 IF( kt == kwrite ) THEN 1713 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1714 CALL xios_send_field(trim(cdvar), pvar) 1715 ENDIF 1770 IF( kt == kwrite ) THEN 1771 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1772 CALL iom_swap(context) 1773 CALL iom_put(trim(cdvar), pvar) 1774 CALL iom_swap(cxios_context) 1775 ELSE 1776 IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D)',trim(cdvar) 1777 CALL iom_swap(context) 1778 CALL iom_set_rstw_active( trim(cdvar), rs2 = pvar ) 1779 CALL iom_swap(cxios_context) 1780 ENDIF 1716 1781 #endif 1717 1782 ELSE … … 1725 1790 END SUBROUTINE iom_rp2d_sp 1726 1791 1727 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1792 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1728 1793 INTEGER , INTENT(in) :: kt ! ocean time-step 1729 1794 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1732 1797 REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1733 1798 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1734 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1735 LOGICAL :: llx 1736 INTEGER :: ivid ! variable id 1737 1738 llx = .FALSE. 1739 IF(PRESENT(ldxios)) llx = ldxios 1799 ! 1800 LOGICAL :: llx 1801 INTEGER :: ivid ! variable id 1802 CHARACTER(LEN=lc) :: context 1803 ! 1804 CALL set_xios_context(kiomid, context) 1805 1806 llx = .NOT. (context == "NONE") 1807 1740 1808 IF( llx ) THEN 1741 1809 #ifdef key_iomput 1742 IF( kt == kwrite ) THEN 1743 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1744 CALL xios_send_field(trim(cdvar), pvar) 1745 ENDIF 1810 IF( kt == kwrite ) THEN 1811 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1812 CALL iom_swap(context) 1813 CALL iom_put(trim(cdvar), pvar) 1814 CALL iom_swap(cxios_context) 1815 ELSE 1816 IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D)',trim(cdvar) 1817 CALL iom_swap(context) 1818 CALL iom_set_rstw_active( trim(cdvar), rd2 = pvar ) 1819 CALL iom_swap(cxios_context) 1820 ENDIF 1746 1821 #endif 1747 1822 ELSE … … 1756 1831 1757 1832 1758 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1833 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1759 1834 INTEGER , INTENT(in) :: kt ! ocean time-step 1760 1835 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1763 1838 REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1764 1839 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1765 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1766 LOGICAL :: llx ! local xios write flag 1767 INTEGER :: ivid ! variable id 1768 1769 llx = .FALSE. 1770 IF(PRESENT(ldxios)) llx = ldxios 1840 ! 1841 LOGICAL :: llx ! local xios write flag 1842 INTEGER :: ivid ! variable id 1843 CHARACTER(LEN=lc) :: context 1844 ! 1845 CALL set_xios_context(kiomid, context) 1846 1847 llx = .NOT. (context == "NONE") 1848 1771 1849 IF( llx ) THEN 1772 1850 #ifdef key_iomput 1773 IF( kt == kwrite ) THEN 1774 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1775 CALL xios_send_field(trim(cdvar), pvar) 1776 ENDIF 1851 IF( kt == kwrite ) THEN 1852 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1853 CALL iom_swap(context) 1854 CALL iom_put(trim(cdvar), pvar) 1855 CALL iom_swap(cxios_context) 1856 ELSE 1857 IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D)',trim(cdvar) 1858 CALL iom_swap(context) 1859 CALL iom_set_rstw_active( trim(cdvar), rs3 = pvar ) 1860 CALL iom_swap(cxios_context) 1861 ENDIF 1777 1862 #endif 1778 1863 ELSE … … 1786 1871 END SUBROUTINE iom_rp3d_sp 1787 1872 1788 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1873 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1789 1874 INTEGER , INTENT(in) :: kt ! ocean time-step 1790 1875 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1793 1878 REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1794 1879 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1795 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1796 LOGICAL :: llx ! local xios write flag 1797 INTEGER :: ivid ! variable id 1798 1799 llx = .FALSE. 1800 IF(PRESENT(ldxios)) llx = ldxios 1880 ! 1881 LOGICAL :: llx ! local xios write flag 1882 INTEGER :: ivid ! variable id 1883 CHARACTER(LEN=lc) :: context 1884 ! 1885 CALL set_xios_context(kiomid, context) 1886 1887 llx = .NOT. (context == "NONE") 1888 1801 1889 IF( llx ) THEN 1802 1890 #ifdef key_iomput 1803 IF( kt == kwrite ) THEN 1804 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1805 CALL xios_send_field(trim(cdvar), pvar) 1806 ENDIF 1891 IF( kt == kwrite ) THEN 1892 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1893 CALL iom_swap(context) 1894 CALL iom_put(trim(cdvar), pvar) 1895 CALL iom_swap(cxios_context) 1896 ELSE 1897 IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D)',trim(cdvar) 1898 CALL iom_swap(context) 1899 CALL iom_set_rstw_active( trim(cdvar), rd3 = pvar ) 1900 CALL iom_swap(cxios_context) 1901 ENDIF 1807 1902 #endif 1808 1903 ELSE … … 2150 2245 CALL iom_swap( cdname ) ! swap to cdname context 2151 2246 CALL xios_update_calendar(kt) 2152 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context)) ! return back to nemo context2247 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( cxios_context ) ! return back to nemo context 2153 2248 END SUBROUTINE iom_setkt 2154 2249 … … 2164 2259 CALL iom_swap( cdname ) ! swap to cdname context 2165 2260 CALL xios_context_finalize() ! finalize the context 2166 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context)) ! return back to nemo context2261 IF( cdname /= cxios_context ) CALL iom_swap( cxios_context ) ! return back to nemo context 2167 2262 ENDIF 2168 2263 !
Note: See TracChangeset
for help on using the changeset viewer.
