- Timestamp:
- 2020-12-03T12:20:38+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/IOM/iom.F90 (modified) (68 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette @13292sette10 ^/utils/CI/sette_wave@13990 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/IOM/iom.F90
r13295 r14037 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. 125 !!---------------------------------------------------------------------- 126 ! 130 LOGICAL :: ll_closedef 131 LOGICAL :: ll_exist 132 !!---------------------------------------------------------------------- 133 ! 134 ll_closedef = .TRUE. 127 135 IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 128 136 ! … … 133 141 CALL xios_context_initialize(TRIM(clname), mpi_comm_oce) 134 142 CALL iom_swap( cdname ) 135 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 136 153 137 154 ! Calendar type is now defined in xml file … … 152 169 IF(.NOT.llrst_context) CALL set_scalar 153 170 ! 154 IF( TRIM(cdname) == TRIM(cxios_context)) THEN171 IF( cdname == cxios_context ) THEN 155 172 CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 156 173 CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. ) … … 196 213 ! vertical grid definition 197 214 IF(.NOT.llrst_context) THEN 198 199 200 201 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 ) 202 219 203 220 ! ABL 204 205 206 207 208 209 210 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) ) 211 228 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 CALL iom_set_axis_attr("nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )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) /) ) 233 250 # if defined key_si3 234 235 236 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) /) ) 237 254 # endif 238 255 #if defined key_top 239 IF( ALLOCATED(profsed) ) CALL iom_set_axis_attr( "profsed", paxis = profsed ) 240 #endif 241 CALL iom_set_axis_attr( "icbcla", class_num ) 242 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) ! strange syntaxe and idea... 243 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) ) ! strange syntaxe and idea... 244 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea... 245 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,5) /) ) 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) /) ) 246 266 ENDIF 247 267 ! 248 268 ! automatic definitions of some of the xml attributs 249 IF( TRIM(cdname) == TRIM(crxios_context) ) THEN 250 !set names of the fields in restart file IF using XIOS to read data 251 CALL iom_set_rst_context(.TRUE.) 252 CALL iom_set_rst_vars(rst_rfields) 253 !set which fields are to be read from restart file 254 CALL iom_set_rstr_active() 255 ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 256 !set names of the fields in restart file IF using XIOS to write data 257 CALL iom_set_rst_context(.FALSE.) 258 CALL iom_set_rst_vars(rst_wfields) 259 !set which fields are to be written to a restart file 260 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) 261 279 ELSE 262 280 CALL set_xmlatt 263 281 ENDIF 264 282 ! … … 276 294 END SUBROUTINE iom_init 277 295 278 SUBROUTINE iom_init_closedef 296 SUBROUTINE iom_init_closedef(cdname) 279 297 !!---------------------------------------------------------------------- 280 298 !! *** SUBROUTINE iom_init_closedef *** … … 284 302 !! 285 303 !!---------------------------------------------------------------------- 286 304 CHARACTER(len=*), OPTIONAL, INTENT(IN) :: cdname 287 305 #if defined key_iomput 288 CALL xios_close_context_definition() 289 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 290 324 #else 291 325 IF( .FALSE. ) WRITE(numout,*) 'iom_init_closedef: should not see this' ! useless statement to avoid compilation warnings … … 294 328 END SUBROUTINE iom_init_closedef 295 329 296 SUBROUTINE iom_set_ rstw_var_active(field)330 SUBROUTINE iom_set_vars_active(idnum) 297 331 !!--------------------------------------------------------------------- 298 !! *** SUBROUTINE iom_set_rstw_var_active *** 299 !! 300 !! ** 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. 301 337 !!--------------------------------------------------------------------- 302 CHARACTER(len = *), INTENT(IN) :: field 303 INTEGER :: i 304 LOGICAL :: llis_set 305 CHARACTER(LEN=256) :: clinfo ! info character 306 338 INTEGER, INTENT(IN) :: idnum 339 307 340 #if defined key_iomput 308 llis_set = .FALSE. 309 310 DO i = 1, max_rst_fields 311 IF(TRIM(rst_wfields(i)%vname) == field) THEN 312 rst_wfields(i)%active = .TRUE. 313 llis_set = .TRUE. 314 EXIT 315 ENDIF 316 ENDDO 317 !Warn if variable is not in defined in rst_wfields 318 IF(.NOT.llis_set) THEN 319 WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 320 CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 ) 321 ENDIF 322 #else 323 clinfo = 'iom_set_rstw_var_active: key_iomput is needed to use XIOS restart read/write functionality' 324 CALL ctl_stop('STOP', TRIM(clinfo)) 325 #endif 326 327 END SUBROUTINE iom_set_rstw_var_active 328 329 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) 330 440 !!--------------------------------------------------------------------- 331 !! *** SUBROUTINE iom_set_rstr_active *** 332 !! 333 !! ** Purpose : define file name in XIOS context for reading restart file, 334 !! 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 335 444 !!--------------------------------------------------------------------- 336 337 !sets enabled = .TRUE. for each field in restart file 338 CHARACTER(len=256) :: rst_file 339 445 CHARACTER(len=*) :: cdrst_file 340 446 #if defined key_iomput 341 TYPE(xios_field) :: field_hdl 342 TYPE(xios_file) :: file_hdl 343 TYPE(xios_filegroup) :: filegroup_hdl 344 INTEGER :: i 345 CHARACTER(lc) :: clpath 346 347 clpath = TRIM(cn_ocerst_indir) 348 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 349 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 350 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 351 ELSE 352 rst_file = TRIM(clpath)//'1_'//TRIM(cn_ocerst_in) 353 ENDIF 447 TYPE(xios_file) :: file_hdl 448 TYPE(xios_filegroup) :: filegroup_hdl 449 354 450 !set name of the restart file and enable available fields 355 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file 356 CALL xios_get_handle("file_definition", filegroup_hdl ) 357 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 358 CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", & 359 par_access="collective", enabled=.TRUE., mode="read", & 360 output_freq=xios_timestep) 361 !define variables for restart context 362 DO i = 1, max_rst_fields 363 IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN 364 IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 365 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname)) 366 SELECT CASE (TRIM(rst_rfields(i)%grid)) 367 CASE ("grid_N_3D") 368 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 369 domain_ref="grid_N", axis_ref="nav_lev", operation = "instant") 370 CASE ("grid_N") 371 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 372 domain_ref="grid_N", operation = "instant") 373 CASE ("grid_vector") 374 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 375 axis_ref="nav_lev", operation = "instant") 376 CASE ("grid_scalar") 377 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 378 scalar_ref = "grid_scalar", operation = "instant") 379 END SELECT 380 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file) 381 ENDIF 382 ENDIF 383 END DO 384 #endif 385 END SUBROUTINE iom_set_rstr_active 386 387 SUBROUTINE iom_set_rstw_core(cdmdl) 388 !!--------------------------------------------------------------------- 389 !! *** SUBROUTINE iom_set_rstw_core *** 390 !! 391 !! ** Purpose : set variables which are always in restart file 392 !!--------------------------------------------------------------------- 393 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS 394 CHARACTER(LEN=256) :: clinfo ! info character 395 #if defined key_iomput 396 IF(cdmdl == "OPA") THEN 397 !from restart.F90 398 CALL iom_set_rstw_var_active("rn_Dt") 399 IF ( .NOT. ln_diurnal_only ) THEN 400 CALL iom_set_rstw_var_active('ub' ) 401 CALL iom_set_rstw_var_active('vb' ) 402 CALL iom_set_rstw_var_active('tb' ) 403 CALL iom_set_rstw_var_active('sb' ) 404 CALL iom_set_rstw_var_active('sshb') 405 ! 406 CALL iom_set_rstw_var_active('un' ) 407 CALL iom_set_rstw_var_active('vn' ) 408 CALL iom_set_rstw_var_active('tn' ) 409 CALL iom_set_rstw_var_active('sn' ) 410 CALL iom_set_rstw_var_active('sshn') 411 CALL iom_set_rstw_var_active('rhop') 412 ENDIF 413 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 414 !from trasbc.F90 415 CALL iom_set_rstw_var_active('sbc_hc_b') 416 CALL iom_set_rstw_var_active('sbc_sc_b') 417 ENDIF 418 #else 419 clinfo = 'iom_set_rstw_core: key_iomput is needed to use XIOS restart read/write functionality' 420 CALL ctl_stop('STOP', TRIM(clinfo)) 421 #endif 422 END SUBROUTINE iom_set_rstw_core 423 424 SUBROUTINE iom_set_rst_vars(fields) 425 !!--------------------------------------------------------------------- 426 !! *** SUBROUTINE iom_set_rst_vars *** 427 !! 428 !! ** Purpose : Fill array fields with the information about all 429 !! possible variables and corresponding grids definition 430 !! for reading/writing restart with XIOS 431 !!--------------------------------------------------------------------- 432 TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields) 433 INTEGER :: i 434 435 i = 0 436 i = i + 1; fields(i)%vname="rn_Dt"; fields(i)%grid="grid_scalar" 437 i = i + 1; fields(i)%vname="un"; fields(i)%grid="grid_N_3D" 438 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D" 439 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D" 440 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D" 441 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D" 442 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D" 443 i = i + 1; fields(i)%vname="sn"; fields(i)%grid="grid_N_3D" 444 i = i + 1; fields(i)%vname="sb"; fields(i)%grid="grid_N_3D" 445 i = i + 1; fields(i)%vname="sshn"; fields(i)%grid="grid_N" 446 i = i + 1; fields(i)%vname="sshb"; fields(i)%grid="grid_N" 447 i = i + 1; fields(i)%vname="rhop"; fields(i)%grid="grid_N_3D" 448 i = i + 1; fields(i)%vname="kt"; fields(i)%grid="grid_scalar" 449 i = i + 1; fields(i)%vname="ndastp"; fields(i)%grid="grid_scalar" 450 i = i + 1; fields(i)%vname="adatrj"; fields(i)%grid="grid_scalar" 451 i = i + 1; fields(i)%vname="utau_b"; fields(i)%grid="grid_N" 452 i = i + 1; fields(i)%vname="vtau_b"; fields(i)%grid="grid_N" 453 i = i + 1; fields(i)%vname="qns_b"; fields(i)%grid="grid_N" 454 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N" 455 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N" 456 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D" 457 i = i + 1; fields(i)%vname="avt_k"; fields(i)%grid="grid_N_3D" 458 i = i + 1; fields(i)%vname="avm_k"; fields(i)%grid="grid_N_3D" 459 i = i + 1; fields(i)%vname="dissl"; fields(i)%grid="grid_N_3D" 460 i = i + 1; fields(i)%vname="sbc_hc_b"; fields(i)%grid="grid_N" 461 i = i + 1; fields(i)%vname="sbc_sc_b"; fields(i)%grid="grid_N" 462 i = i + 1; fields(i)%vname="qsr_hc_b"; fields(i)%grid="grid_N_3D" 463 i = i + 1; fields(i)%vname="fraqsr_1lev"; fields(i)%grid="grid_N" 464 i = i + 1; fields(i)%vname="greenland_icesheet_mass" 465 fields(i)%grid="grid_scalar" 466 i = i + 1; fields(i)%vname="greenland_icesheet_timelapsed" 467 fields(i)%grid="grid_scalar" 468 i = i + 1; fields(i)%vname="greenland_icesheet_mass_roc" 469 fields(i)%grid="grid_scalar" 470 i = i + 1; fields(i)%vname="antarctica_icesheet_mass" 471 fields(i)%grid="grid_scalar" 472 i = i + 1; fields(i)%vname="antarctica_icesheet_timelapsed" 473 fields(i)%grid="grid_scalar" 474 i = i + 1; fields(i)%vname="antarctica_icesheet_mass_roc" 475 fields(i)%grid="grid_scalar" 476 i = i + 1; fields(i)%vname="frc_v"; fields(i)%grid="grid_scalar" 477 i = i + 1; fields(i)%vname="frc_t"; fields(i)%grid="grid_scalar" 478 i = i + 1; fields(i)%vname="frc_s"; fields(i)%grid="grid_scalar" 479 i = i + 1; fields(i)%vname="frc_wn_t"; fields(i)%grid="grid_scalar" 480 i = i + 1; fields(i)%vname="frc_wn_s"; fields(i)%grid="grid_scalar" 481 i = i + 1; fields(i)%vname="ssh_ini"; fields(i)%grid="grid_N" 482 i = i + 1; fields(i)%vname="e3t_ini"; fields(i)%grid="grid_N_3D" 483 i = i + 1; fields(i)%vname="hc_loc_ini"; fields(i)%grid="grid_N_3D" 484 i = i + 1; fields(i)%vname="sc_loc_ini"; fields(i)%grid="grid_N_3D" 485 i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N" 486 i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N" 487 i = i + 1; fields(i)%vname="tilde_e3t_b"; fields(i)%grid="grid_N" 488 i = i + 1; fields(i)%vname="tilde_e3t_n"; fields(i)%grid="grid_N" 489 i = i + 1; fields(i)%vname="hdiv_lf"; fields(i)%grid="grid_N" 490 i = i + 1; fields(i)%vname="ub2_b"; fields(i)%grid="grid_N" 491 i = i + 1; fields(i)%vname="vb2_b"; fields(i)%grid="grid_N" 492 i = i + 1; fields(i)%vname="sshbb_e"; fields(i)%grid="grid_N" 493 i = i + 1; fields(i)%vname="ubb_e"; fields(i)%grid="grid_N" 494 i = i + 1; fields(i)%vname="vbb_e"; fields(i)%grid="grid_N" 495 i = i + 1; fields(i)%vname="sshb_e"; fields(i)%grid="grid_N" 496 i = i + 1; fields(i)%vname="ub_e"; fields(i)%grid="grid_N" 497 i = i + 1; fields(i)%vname="vb_e"; fields(i)%grid="grid_N" 498 i = i + 1; fields(i)%vname="fwf_isf_b"; fields(i)%grid="grid_N" 499 i = i + 1; fields(i)%vname="isf_sc_b"; fields(i)%grid="grid_N" 500 i = i + 1; fields(i)%vname="isf_hc_b"; fields(i)%grid="grid_N" 501 i = i + 1; fields(i)%vname="ssh_ibb"; fields(i)%grid="grid_N" 502 i = i + 1; fields(i)%vname="rnf_b"; fields(i)%grid="grid_N" 503 i = i + 1; fields(i)%vname="rnf_hc_b"; fields(i)%grid="grid_N" 504 i = i + 1; fields(i)%vname="rnf_sc_b"; fields(i)%grid="grid_N" 505 i = i + 1; fields(i)%vname="nn_fsbc"; fields(i)%grid="grid_scalar" 506 i = i + 1; fields(i)%vname="ssu_m"; fields(i)%grid="grid_N" 507 i = i + 1; fields(i)%vname="ssv_m"; fields(i)%grid="grid_N" 508 i = i + 1; fields(i)%vname="sst_m"; fields(i)%grid="grid_N" 509 i = i + 1; fields(i)%vname="sss_m"; fields(i)%grid="grid_N" 510 i = i + 1; fields(i)%vname="ssh_m"; fields(i)%grid="grid_N" 511 i = i + 1; fields(i)%vname="e3t_m"; fields(i)%grid="grid_N" 512 i = i + 1; fields(i)%vname="frq_m"; fields(i)%grid="grid_N" 513 i = i + 1; fields(i)%vname="avmb"; fields(i)%grid="grid_vector" 514 i = i + 1; fields(i)%vname="avtb"; fields(i)%grid="grid_vector" 515 i = i + 1; fields(i)%vname="ub2_i_b"; fields(i)%grid="grid_N" 516 i = i + 1; fields(i)%vname="vb2_i_b"; fields(i)%grid="grid_N" 517 i = i + 1; fields(i)%vname="ntime"; fields(i)%grid="grid_scalar" 518 i = i + 1; fields(i)%vname="Dsst"; fields(i)%grid="grid_scalar" 519 i = i + 1; fields(i)%vname="tmask"; fields(i)%grid="grid_N_3D" 520 i = i + 1; fields(i)%vname="umask"; fields(i)%grid="grid_N_3D" 521 i = i + 1; fields(i)%vname="vmask"; fields(i)%grid="grid_N_3D" 522 i = i + 1; fields(i)%vname="smask"; fields(i)%grid="grid_N_3D" 523 i = i + 1; fields(i)%vname="gdepw_n"; fields(i)%grid="grid_N_3D" 524 i = i + 1; fields(i)%vname="e3t_n"; fields(i)%grid="grid_N_3D" 525 i = i + 1; fields(i)%vname="e3u_n"; fields(i)%grid="grid_N_3D" 526 i = i + 1; fields(i)%vname="e3v_n"; fields(i)%grid="grid_N_3D" 527 i = i + 1; fields(i)%vname="surf_ini"; fields(i)%grid="grid_N" 528 i = i + 1; fields(i)%vname="e3t_b"; fields(i)%grid="grid_N_3D" 529 i = i + 1; fields(i)%vname="hmxl_n"; fields(i)%grid="grid_N_3D" 530 i = i + 1; fields(i)%vname="un_bf"; fields(i)%grid="grid_N" 531 i = i + 1; fields(i)%vname="vn_bf"; fields(i)%grid="grid_N" 532 i = i + 1; fields(i)%vname="hbl"; fields(i)%grid="grid_N" 533 i = i + 1; fields(i)%vname="hbli"; fields(i)%grid="grid_N" 534 i = i + 1; fields(i)%vname="wn"; fields(i)%grid="grid_N_3D" 535 536 IF( i-1 > max_rst_fields) THEN 537 WRITE(ctmp1,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small' 538 CALL ctl_stop( 'iom_set_rst_vars:', ctmp1 ) 539 ENDIF 540 END SUBROUTINE iom_set_rst_vars 541 542 543 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) 544 469 !!--------------------------------------------------------------------- 545 470 !! *** SUBROUTINE iom_set_rstw_active *** … … 549 474 !!--------------------------------------------------------------------- 550 475 !sets enabled = .TRUE. for each field in restart file 551 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 552 485 #if defined key_iomput 553 TYPE(xios_field) :: field_hdl 554 TYPE(xios_file) :: file_hdl 555 TYPE(xios_filegroup) :: filegroup_hdl 556 INTEGER :: i 557 CHARACTER(lc) :: clpath 558 559 !set name of the restart file and enable available fields 560 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file 561 CALL xios_get_handle("file_definition", filegroup_hdl ) 562 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 563 IF(nxioso.eq.1) THEN 564 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 565 mode="write", output_freq=xios_timestep) 566 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 567 ELSE 568 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 569 mode="write", output_freq=xios_timestep) 570 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 571 ENDIF 572 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) 573 490 !define fields for restart context 574 DO i = 1, max_rst_fields 575 IF( rst_wfields(i)%active ) THEN 576 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname)) 577 SELECT CASE (TRIM(rst_wfields(i)%grid)) 578 CASE ("grid_N_3D") 579 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 580 domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant") 581 CASE ("grid_N") 582 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 583 domain_ref="grid_N", prec = 8, operation = "instant") 584 CASE ("grid_vector") 585 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 586 axis_ref="nav_lev", prec = 8, operation = "instant") 587 CASE ("grid_scalar") 588 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 589 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 590 END SELECT 591 ENDIF 592 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 593 528 #endif 594 529 END SUBROUTINE iom_set_rstw_active 595 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 596 580 SUBROUTINE iom_set_rst_context(ld_rstr) 597 !!---------------------------------------------------------------------581 !!--------------------------------------------------------------------- 598 582 !! *** SUBROUTINE iom_set_rst_context *** 599 583 !! … … 602 586 !! 603 587 !!--------------------------------------------------------------------- 604 LOGICAL, INTENT(IN) :: ld_rstr 605 !ld_rstr is true for restart context. There is no need to define grid for 606 !restart read, because it's read from file 588 LOGICAL, INTENT(IN) :: ld_rstr 589 INTEGER :: ji 607 590 #if defined key_iomput 608 TYPE(xios_domaingroup) :: domaingroup_hdl609 TYPE(xios_domain) :: domain_hdl610 TYPE(xios_axisgroup) :: axisgroup_hdl611 TYPE(xios_axis) :: axis_hdl612 TYPE(xios_scalar) :: scalar_hdl613 TYPE(xios_scalargroup) :: scalargroup_hdl614 615 CALL xios_get_handle("domain_definition",domaingroup_hdl)616 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")617 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) 618 601 619 CALL xios_get_handle("axis_definition",axisgroup_hdl)620 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") 621 604 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 622 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 623 CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 624 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 625 626 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 627 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") 628 614 #endif 629 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 630 655 631 656 SUBROUTINE iom_swap( cdname ) … … 638 663 #if defined key_iomput 639 664 TYPE(xios_context) :: nemo_hdl 640 641 665 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 642 666 CALL xios_get_handle(TRIM(cdname),nemo_hdl) … … 888 912 !! INTERFACE iom_get 889 913 !!---------------------------------------------------------------------- 890 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime , ldxios)914 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime ) 891 915 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 892 916 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable … … 894 918 REAL(dp) :: ztmp_pvar ! tmp var to read field 895 919 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 896 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart897 920 ! 898 921 INTEGER :: idvar ! variable id … … 902 925 CHARACTER(LEN=100) :: clname ! file name 903 926 CHARACTER(LEN=1) :: cldmspc ! 904 LOGICAL :: llxios 905 ! 906 llxios = .FALSE. 907 IF( PRESENT(ldxios) ) llxios = ldxios 908 909 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 910 932 itime = 1 911 933 IF( PRESENT(ktime) ) itime = ktime … … 930 952 #if defined key_iomput 931 953 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 932 CALL iom_swap( TRIM(crxios_context))954 CALL iom_swap(context) 933 955 CALL xios_recv_field( trim(cdvar), pvar) 934 CALL iom_swap( TRIM(cxios_context))956 CALL iom_swap(cxios_context) 935 957 #else 936 958 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 940 962 END SUBROUTINE iom_g0d_sp 941 963 942 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime , ldxios)964 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime ) 943 965 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 944 966 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 945 967 REAL(dp) , INTENT( out) :: pvar ! read field 946 968 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 947 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart948 969 ! 949 970 INTEGER :: idvar ! variable id … … 953 974 CHARACTER(LEN=100) :: clname ! file name 954 975 CHARACTER(LEN=1) :: cldmspc ! 955 LOGICAL :: llxios 956 ! 957 llxios = .FALSE. 958 IF( PRESENT(ldxios) ) llxios = ldxios 959 960 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 961 981 itime = 1 962 982 IF( PRESENT(ktime) ) itime = ktime … … 980 1000 #if defined key_iomput 981 1001 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 982 CALL iom_swap( TRIM(crxios_context))1002 CALL iom_swap(context) 983 1003 CALL xios_recv_field( trim(cdvar), pvar) 984 CALL iom_swap( TRIM(cxios_context))1004 CALL iom_swap(cxios_context) 985 1005 #else 986 1006 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 990 1010 END SUBROUTINE iom_g0d_dp 991 1011 992 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)1012 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 993 1013 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 994 1014 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 999 1019 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1000 1020 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1001 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1002 1021 ! 1003 1022 IF( kiomid > 0 ) THEN … … 1005 1024 ALLOCATE(ztmp_pvar(size(pvar,1))) 1006 1025 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=ztmp_pvar, & 1007 & ktime=ktime, kstart=kstart, kcount=kcount, & 1008 & ldxios=ldxios ) 1026 & ktime=ktime, kstart=kstart, kcount=kcount ) 1009 1027 pvar = ztmp_pvar 1010 1028 DEALLOCATE(ztmp_pvar) … … 1014 1032 1015 1033 1016 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)1034 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 1017 1035 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1018 1036 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1022 1040 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1023 1041 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1024 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1025 1042 ! 1026 1043 IF( kiomid > 0 ) THEN 1027 1044 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 1028 & ktime=ktime, kstart=kstart, kcount=kcount, & 1029 & ldxios=ldxios ) 1045 & ktime=ktime, kstart=kstart, kcount=kcount) 1030 1046 ENDIF 1031 1047 END SUBROUTINE iom_g1d_dp 1032 1048 1033 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) 1034 1050 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1035 1051 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1043 1059 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1044 1060 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1045 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1046 1061 ! 1047 1062 IF( kiomid > 0 ) THEN … … 1050 1065 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = ztmp_pvar , ktime = ktime, & 1051 1066 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1052 & kstart = kstart , kcount = kcount , ldxios=ldxios)1067 & kstart = kstart , kcount = kcount ) 1053 1068 pvar = ztmp_pvar 1054 1069 DEALLOCATE(ztmp_pvar) … … 1057 1072 END SUBROUTINE iom_g2d_sp 1058 1073 1059 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) 1060 1075 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1061 1076 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1068 1083 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1069 1084 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1070 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1071 1085 ! 1072 1086 IF( kiomid > 0 ) THEN 1073 1087 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = pvar , ktime = ktime, & 1074 1088 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1075 & kstart = kstart , kcount = kcount , ldxios=ldxios)1089 & kstart = kstart , kcount = kcount ) 1076 1090 ENDIF 1077 1091 END SUBROUTINE iom_g2d_dp 1078 1092 1079 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 ) 1080 1094 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1081 1095 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1089 1103 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1090 1104 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1091 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1092 1105 ! 1093 1106 IF( kiomid > 0 ) THEN … … 1096 1109 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = ztmp_pvar , ktime = ktime, & 1097 1110 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1098 & kstart = kstart , kcount = kcount , ldxios=ldxios)1111 & kstart = kstart , kcount = kcount ) 1099 1112 pvar = ztmp_pvar 1100 1113 DEALLOCATE(ztmp_pvar) … … 1103 1116 END SUBROUTINE iom_g3d_sp 1104 1117 1105 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 ) 1106 1119 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1107 1120 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1114 1127 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1115 1128 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1116 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1117 1129 ! 1118 1130 IF( kiomid > 0 ) THEN … … 1120 1132 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1121 1133 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1122 & kstart = kstart , kcount = kcount , ldxios=ldxios)1134 & kstart = kstart , kcount = kcount ) 1123 1135 END IF 1124 1136 ENDIF … … 1128 1140 1129 1141 SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime , & 1130 & cd_type, psgn, kfill, kstart, kcount , ldxios)1142 & cd_type, psgn, kfill, kstart, kcount ) 1131 1143 !!----------------------------------------------------------------------- 1132 1144 !! *** ROUTINE iom_get_123d *** … … 1148 1160 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1149 1161 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1150 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart1151 1162 ! 1152 1163 LOGICAL :: llok ! true if ok! 1153 LOGICAL :: llxios ! local definition for XIOS read1154 1164 INTEGER :: jl ! loop on number of dimension 1155 1165 INTEGER :: idom ! type of domain … … 1178 1188 REAL(dp) :: gma, gmi 1179 1189 !--------------------------------------------------------------------- 1180 ! 1190 CHARACTER(LEN=lc) :: context 1191 ! 1192 CALL set_xios_context(kiomid, context) 1181 1193 inlev = -1 1182 1194 IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3) 1183 1195 ! 1184 llxios = .FALSE.1185 IF( PRESENT(ldxios) ) llxios = ldxios1186 !1187 1196 idom = kdom 1188 1197 istop = nstop 1189 1198 ! 1190 IF( .NOT.llxios) THEN1199 IF(context == "NONE") THEN 1191 1200 clname = iom_file(kiomid)%name ! esier to read 1192 1201 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) … … 1355 1364 #if defined key_iomput 1356 1365 !would be good to be able to check which context is active and swap only if current is not restart 1357 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 1358 1373 IF( PRESENT(pv_r3d) ) THEN 1359 1374 IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 1360 CALL xios_recv_field( trim(cdvar), pv_r3d) 1361 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 1362 1379 ELSEIF( PRESENT(pv_r2d) ) THEN 1363 1380 IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 1364 CALL xios_recv_field( trim(cdvar), pv_r2d) 1365 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 1366 1385 ELSEIF( PRESENT(pv_r1d) ) THEN 1367 1386 IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 1368 1387 CALL xios_recv_field( trim(cdvar), pv_r1d) 1369 1388 ENDIF 1370 CALL iom_swap( TRIM(cxios_context))1389 CALL iom_swap(cxios_context) 1371 1390 #else 1372 1391 istop = istop + 1 … … 1383 1402 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1384 1403 IF( PRESENT(pv_r1d) ) THEN 1385 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf1386 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 1387 1406 ELSEIF( PRESENT(pv_r2d) ) THEN 1388 IF( zscf /= 1. ) pv_r2d(:,:) = pv_r2d(:,:) * zscf1389 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 1390 1409 ELSEIF( PRESENT(pv_r3d) ) THEN 1391 IF( zscf /= 1. ) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf1392 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 1393 1412 ENDIF 1394 1413 ! … … 1564 1583 !! INTERFACE iom_rstput 1565 1584 !!---------------------------------------------------------------------- 1566 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1585 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1567 1586 INTEGER , INTENT(in) :: kt ! ocean time-step 1568 1587 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1571 1590 REAL(sp) , INTENT(in) :: pvar ! written field 1572 1591 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1573 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1574 LOGICAL :: llx ! local xios write flag 1575 INTEGER :: ivid ! variable id 1576 1577 llx = .FALSE. 1578 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 1579 1601 IF( llx ) THEN 1580 1602 #ifdef key_iomput 1581 IF( kt == kwrite ) THEN 1582 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1583 CALL xios_send_field(trim(cdvar), pvar) 1584 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 1585 1614 #endif 1586 1615 ELSE … … 1594 1623 END SUBROUTINE iom_rp0d_sp 1595 1624 1596 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1625 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1597 1626 INTEGER , INTENT(in) :: kt ! ocean time-step 1598 1627 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1601 1630 REAL(dp) , INTENT(in) :: pvar ! written field 1602 1631 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1603 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1604 LOGICAL :: llx ! local xios write flag 1605 INTEGER :: ivid ! variable id 1606 1607 llx = .FALSE. 1608 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 1609 1641 IF( llx ) THEN 1610 1642 #ifdef key_iomput 1611 IF( kt == kwrite ) THEN 1612 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1613 CALL xios_send_field(trim(cdvar), pvar) 1614 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 1615 1654 #endif 1616 1655 ELSE … … 1625 1664 1626 1665 1627 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1666 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1628 1667 INTEGER , INTENT(in) :: kt ! ocean time-step 1629 1668 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1632 1671 REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1633 1672 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1634 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1635 LOGICAL :: llx ! local xios write flag 1636 INTEGER :: ivid ! variable id 1637 1638 llx = .FALSE. 1639 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 1640 1682 IF( llx ) THEN 1641 1683 #ifdef key_iomput 1642 IF( kt == kwrite ) THEN 1643 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1644 CALL xios_send_field(trim(cdvar), pvar) 1645 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 1646 1695 #endif 1647 1696 ELSE … … 1655 1704 END SUBROUTINE iom_rp1d_sp 1656 1705 1657 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1706 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1658 1707 INTEGER , INTENT(in) :: kt ! ocean time-step 1659 1708 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1662 1711 REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1663 1712 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1664 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1665 LOGICAL :: llx ! local xios write flag 1666 INTEGER :: ivid ! variable id 1667 1668 llx = .FALSE. 1669 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 1670 1722 IF( llx ) THEN 1671 1723 #ifdef key_iomput 1672 IF( kt == kwrite ) THEN 1673 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1674 CALL xios_send_field(trim(cdvar), pvar) 1675 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 1676 1735 #endif 1677 1736 ELSE … … 1686 1745 1687 1746 1688 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1747 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1689 1748 INTEGER , INTENT(in) :: kt ! ocean time-step 1690 1749 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1693 1752 REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1694 1753 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1695 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1696 LOGICAL :: llx 1697 INTEGER :: ivid ! variable id 1698 1699 llx = .FALSE. 1700 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 1701 1763 IF( llx ) THEN 1702 1764 #ifdef key_iomput 1703 IF( kt == kwrite ) THEN 1704 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1705 CALL xios_send_field(trim(cdvar), pvar) 1706 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 1707 1776 #endif 1708 1777 ELSE … … 1716 1785 END SUBROUTINE iom_rp2d_sp 1717 1786 1718 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1787 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1719 1788 INTEGER , INTENT(in) :: kt ! ocean time-step 1720 1789 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1723 1792 REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1724 1793 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1725 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1726 LOGICAL :: llx 1727 INTEGER :: ivid ! variable id 1728 1729 llx = .FALSE. 1730 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 1731 1803 IF( llx ) THEN 1732 1804 #ifdef key_iomput 1733 IF( kt == kwrite ) THEN 1734 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1735 CALL xios_send_field(trim(cdvar), pvar) 1736 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 1737 1816 #endif 1738 1817 ELSE … … 1747 1826 1748 1827 1749 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1828 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1750 1829 INTEGER , INTENT(in) :: kt ! ocean time-step 1751 1830 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1754 1833 REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1755 1834 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1756 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1757 LOGICAL :: llx ! local xios write flag 1758 INTEGER :: ivid ! variable id 1759 1760 llx = .FALSE. 1761 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 1762 1844 IF( llx ) THEN 1763 1845 #ifdef key_iomput 1764 IF( kt == kwrite ) THEN 1765 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1766 CALL xios_send_field(trim(cdvar), pvar) 1767 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 1768 1857 #endif 1769 1858 ELSE … … 1777 1866 END SUBROUTINE iom_rp3d_sp 1778 1867 1779 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1868 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1780 1869 INTEGER , INTENT(in) :: kt ! ocean time-step 1781 1870 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1784 1873 REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1785 1874 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1786 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1787 LOGICAL :: llx ! local xios write flag 1788 INTEGER :: ivid ! variable id 1789 1790 llx = .FALSE. 1791 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 1792 1884 IF( llx ) THEN 1793 1885 #ifdef key_iomput 1794 IF( kt == kwrite ) THEN 1795 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1796 CALL xios_send_field(trim(cdvar), pvar) 1797 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 1798 1897 #endif 1799 1898 ELSE … … 1861 1960 CHARACTER(LEN=*), INTENT(in) :: cdname 1862 1961 REAL(sp) , INTENT(in) :: pfield0d 1863 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson1962 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1864 1963 #if defined key_iomput 1865 1964 !!clem zz(:,:)=pfield0d … … 1910 2009 IF( iom_use(cdname) ) THEN 1911 2010 #if defined key_iomput 1912 IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 1913 CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) ) ! this extraction will create a copy of pfield2d 1914 ELSE 1915 CALL xios_send_field( cdname, pfield2d ) 1916 ENDIF 2011 CALL xios_send_field( cdname, pfield2d ) 1917 2012 #else 1918 2013 WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings … … 1926 2021 IF( iom_use(cdname) ) THEN 1927 2022 #if defined key_iomput 1928 IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 1929 CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) ) ! this extraction will create a copy of pfield2d 1930 ELSE 1931 CALL xios_send_field( cdname, pfield2d ) 1932 ENDIF 2023 CALL xios_send_field( cdname, pfield2d ) 1933 2024 #else 1934 2025 WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings … … 1942 2033 IF( iom_use(cdname) ) THEN 1943 2034 #if defined key_iomput 1944 IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 1945 CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) ) ! this extraction will create a copy of pfield3d 1946 ELSE 1947 CALL xios_send_field( cdname, pfield3d ) 1948 ENDIF 2035 CALL xios_send_field( cdname, pfield3d ) 1949 2036 #else 1950 2037 WRITE(numout,*) pfield3d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings … … 1958 2045 IF( iom_use(cdname) ) THEN 1959 2046 #if defined key_iomput 1960 IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 1961 CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) ) ! this extraction will create a copy of pfield3d 1962 ELSE 1963 CALL xios_send_field( cdname, pfield3d ) 1964 ENDIF 2047 CALL xios_send_field( cdname, pfield3d ) 1965 2048 #else 1966 2049 WRITE(numout,*) pfield3d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings … … 1974 2057 IF( iom_use(cdname) ) THEN 1975 2058 #if defined key_iomput 1976 IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 1977 CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) ) ! this extraction will create a copy of pfield4d 1978 ELSE 1979 CALL xios_send_field (cdname, pfield4d ) 1980 ENDIF 2059 CALL xios_send_field (cdname, pfield4d ) 1981 2060 #else 1982 2061 WRITE(numout,*) pfield4d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings … … 1990 2069 IF( iom_use(cdname) ) THEN 1991 2070 #if defined key_iomput 1992 IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 1993 CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) ) ! this extraction will create a copy of pfield4d 1994 ELSE 1995 CALL xios_send_field (cdname, pfield4d ) 1996 ENDIF 2071 CALL xios_send_field (cdname, pfield4d ) 1997 2072 #else 1998 2073 WRITE(numout,*) pfield4d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings … … 2165 2240 CALL iom_swap( cdname ) ! swap to cdname context 2166 2241 CALL xios_update_calendar(kt) 2167 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 2168 2243 END SUBROUTINE iom_setkt 2169 2244 … … 2179 2254 CALL iom_swap( cdname ) ! swap to cdname context 2180 2255 CALL xios_context_finalize() ! finalize the context 2181 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 2182 2257 ENDIF 2183 2258 ! … … 2200 2275 ! 2201 2276 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0) 2202 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0)2277 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni = jpi, data_jbegin = -nn_hls, data_nj = jpj) 2203 2278 !don't define lon and lat for restart reading context. 2204 2279 IF ( .NOT.ldrxios ) & … … 2299 2374 CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 2300 2375 CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0) 2301 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0)2376 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = -nn_hls, data_ni = jpi, data_jbegin = -nn_hls, data_nj = jpj) 2302 2377 CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp), & 2303 2378 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp)) 2304 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj _0)2379 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj0glo) 2305 2380 ! 2306 2381 CALL iom_update_file_name('ptr')
Note: See TracChangeset
for help on using the changeset viewer.
