- Timestamp:
- 2020-12-02T16:32:24+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/IOM
- Files:
-
- 6 edited
-
in_out_manager.F90 (modified) (5 diffs)
-
iom.F90 (modified) (60 diffs)
-
iom_def.F90 (modified) (5 diffs)
-
iom_nf90.F90 (modified) (17 diffs)
-
prtctl.F90 (modified) (11 diffs)
-
restart.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/IOM/in_out_manager.F90
r13286 r14017 1 MODULE in_out_manager 1 MODULE in_out_manager 2 2 !!====================================================================== 3 3 !! *** MODULE in_out_manager *** … … 53 53 ! The following four values determine the partitioning of the output fields 54 54 ! into netcdf4 chunks. They are unrelated to the nn_chunk_sz setting which is 55 ! for runtime optimisation. The individual netcdf4 chunks can be optionally 56 ! gzipped (recommended) leading to significant reductions in I/O volumes 55 ! for runtime optimisation. The individual netcdf4 chunks can be optionally 56 ! gzipped (recommended) leading to significant reductions in I/O volumes 57 57 ! !!!** variables only used with iom_nf90 routines and key_netcdf4 ** 58 INTEGER :: nn_nchunks_i !: number of chunks required in the i-dimension 59 INTEGER :: nn_nchunks_j !: number of chunks required in the j-dimension 60 INTEGER :: nn_nchunks_k !: number of chunks required in the k-dimension 61 INTEGER :: nn_nchunks_t !: number of chunks required in the t-dimension 58 INTEGER :: nn_nchunks_i !: number of chunks required in the i-dimension 59 INTEGER :: nn_nchunks_j !: number of chunks required in the j-dimension 60 INTEGER :: nn_nchunks_k !: number of chunks required in the k-dimension 61 INTEGER :: nn_nchunks_t !: number of chunks required in the t-dimension 62 62 LOGICAL :: ln_nc4zip !: netcdf4 usage: (T) chunk and compress output using the HDF5 sublayers of netcdf4 63 ! ! (F) ignore chunking request and use the netcdf4 library 64 ! ! to produce netcdf3-compatible files 63 ! ! (F) ignore chunking request and use the netcdf4 library 64 ! ! to produce netcdf3-compatible files 65 65 #endif 66 66 … … 85 85 !!---------------------------------------------------------------------- 86 86 INTEGER :: nitrst !: time step at which restart file should be written 87 LOGICAL :: lrst_oce !: logical to control the oce restart write 88 LOGICAL :: lrst_ice !: logical to control the ice restart write 89 LOGICAL :: lrst_abl !: logical to control the abl restart write 87 LOGICAL :: lrst_oce !: logical to control the oce restart write 88 LOGICAL :: lrst_ice !: logical to control the ice restart write 89 LOGICAL :: lrst_abl !: logical to control the abl restart write 90 90 INTEGER :: numror = 0 !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 91 INTEGER :: numrir !: logical unit for ice restart (read) 92 INTEGER :: numrar !: logical unit for abl restart (read) 93 INTEGER :: numrow !: logical unit for ocean restart (write) 94 INTEGER :: numriw !: logical unit for ice restart (write) 95 INTEGER :: numraw !: logical unit for abl restart (write) 91 INTEGER :: numrir = 0 !: logical unit for ice restart (read) 92 INTEGER :: numrar = 0 !: logical unit for abl restart (read) 93 INTEGER :: numrow = 0 !: logical unit for ocean restart (write) 94 INTEGER :: numriw = 0 !: logical unit for ice restart (write) 95 INTEGER :: numraw = 0 !: logical unit for abl restart (write) 96 INTEGER :: numrtr = 0 !: trc restart (read ) 97 INTEGER :: numrtw = 0 !: trc restart (write ) 98 INTEGER :: numrsr = 0 !: logical unit for sed restart (read) 99 INTEGER :: numrsw = 0 !: logical unit for sed restart (write) 100 96 101 INTEGER :: nrst_lst !: number of restart to output next 97 102 … … 150 155 151 156 !!---------------------------------------------------------------------- 152 !! Run control 157 !! Run control 153 158 !!---------------------------------------------------------------------- 154 159 INTEGER :: no_print = 0 !: optional argument of fld_fill (if present, suppress some control print) … … 165 170 LOGICAL :: lwp = .FALSE. !: boolean : true on the 1st processor only .OR. sn_cfctl%l_oceout=T 166 171 LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area 167 CHARACTER(lc) :: cxios_context !: context name used in xios 168 CHARACTER(lc) :: crxios_context !: context name used in xios to read restart 169 CHARACTER(lc) :: cwxios_context !: context name used in xios to write restart file 172 CHARACTER(LEN=lc) :: cxios_context !: context name used in xios 173 CHARACTER(LEN=lc) :: cr_ocerst_cxt !: context name used in xios to read OCE restart 174 CHARACTER(LEN=lc) :: cw_ocerst_cxt !: context name used in xios to write OCE restart file 175 CHARACTER(LEN=lc) :: cr_icerst_cxt !: context name used in xios to read SI3 restart 176 CHARACTER(LEN=lc) :: cw_icerst_cxt !: context name used in xios to write SI3 restart file 177 CHARACTER(LEN=lc) :: cr_toprst_cxt !: context name used in xios to read TOP restart 178 CHARACTER(LEN=lc) :: cw_toprst_cxt !: context name used in xios to write TOP restart file 179 CHARACTER(LEN=lc) :: cr_sedrst_cxt !: context name used in xios to read SEDIMENT restart 180 CHARACTER(LEN=lc) :: cw_sedrst_cxt !: context name used in xios to write SEDIMENT restart file 181 182 183 170 184 171 185 !! * Substitutions -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/IOM/iom.F90
r13806 r14017 46 46 USE lib_fortran 47 47 USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal 48 USE iom_nf90 49 USE netcdf 48 50 49 51 IMPLICIT NONE … … 58 60 PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put 59 61 PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val 62 PUBLIC iom_xios_setid 60 63 61 64 PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp … … 69 72 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 70 73 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate 71 PRIVATE iom_set_rst_context, iom_set_ rstw_active, iom_set_rstr_active74 PRIVATE iom_set_rst_context, iom_set_vars_active 72 75 # endif 73 PUBLIC iom_set_rstw_var_active, iom_set_rstw_core, iom_set_rst_vars 76 PRIVATE set_xios_context 77 PRIVATE iom_set_rstw_active 74 78 75 79 INTERFACE iom_get … … 101 105 CONTAINS 102 106 103 SUBROUTINE iom_init( cdname, fname, ld_closedef )107 SUBROUTINE iom_init( cdname, kdid, ld_closedef ) 104 108 !!---------------------------------------------------------------------- 105 109 !! *** ROUTINE *** … … 109 113 !!---------------------------------------------------------------------- 110 114 CHARACTER(len=*), INTENT(in) :: cdname 111 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname115 INTEGER , OPTIONAL, INTENT(in) :: kdid 112 116 LOGICAL , OPTIONAL, INTENT(in) :: ld_closedef 113 117 #if defined key_iomput … … 118 122 INTEGER :: irefyear, irefmonth, irefday 119 123 INTEGER :: ji 120 LOGICAL :: llrst_context ! is context related to restart 124 LOGICAL :: llrst_context ! is context related to restart 125 LOGICAL :: llrstr, llrstw 126 INTEGER :: inum 121 127 ! 122 128 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 123 129 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 124 LOGICAL :: ll_closedef = .TRUE.130 LOGICAL :: ll_closedef 125 131 LOGICAL :: ll_exist 126 132 !!---------------------------------------------------------------------- 127 133 ! 134 ll_closedef = .TRUE. 128 135 IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 129 136 ! … … 134 141 CALL xios_context_initialize(TRIM(clname), mpi_comm_oce) 135 142 CALL iom_swap( cdname ) 136 llrst_context = (TRIM(cdname) == TRIM(crxios_context) .OR. TRIM(cdname) == TRIM(cwxios_context)) 143 144 llrstr = (cdname == cr_ocerst_cxt) .OR. (cdname == cr_icerst_cxt) 145 llrstr = llrstr .OR. (cdname == cr_toprst_cxt) 146 llrstr = llrstr .OR. (cdname == cr_sedrst_cxt) 147 148 llrstw = (cdname == cw_ocerst_cxt) .OR. (cdname == cw_icerst_cxt) 149 llrstw = llrstw .OR. (cdname == cw_toprst_cxt) 150 llrstw = llrstw .OR. (cdname == cw_sedrst_cxt) 151 152 llrst_context = llrstr .OR. llrstw 137 153 138 154 ! Calendar type is now defined in xml file … … 153 169 IF(.NOT.llrst_context) CALL set_scalar 154 170 ! 155 IF( TRIM(cdname) == TRIM(cxios_context)) THEN171 IF( cdname == cxios_context ) THEN 156 172 CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 157 173 CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. ) … … 197 213 ! vertical grid definition 198 214 IF(.NOT.llrst_context) THEN 199 200 201 202 215 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 216 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 217 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 218 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 203 219 204 220 ! ABL 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 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) ) 228 229 ! Add vertical grid bounds 230 zt_bnds(2,: ) = gdept_1d(:) 231 zt_bnds(1,2:jpk ) = gdept_1d(1:jpkm1) 232 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 233 zw_bnds(1,: ) = gdepw_1d(:) 234 zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 235 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 236 CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 237 CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) 238 CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 239 CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 240 241 ! ABL 242 za_bnds(1,:) = ghw_abl(1:jpkam1) 243 za_bnds(2,:) = ghw_abl(2:jpka ) 244 CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds ) 245 za_bnds(1,:) = ght_abl(2:jpka ) 246 za_bnds(2,:) = ght_abl(2:jpka ) + e3w_abl(2:jpka) 247 CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 248 249 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 234 250 # if defined key_si3 235 236 237 251 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 252 ! SIMIP diagnostics (4 main arctic straits) 253 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 238 254 # endif 239 255 #if defined key_top 240 241 #endif 242 243 244 245 246 247 248 249 256 IF( ALLOCATED(profsed) ) CALL iom_set_axis_attr( "profsed", paxis = profsed ) 257 #endif 258 CALL iom_set_axis_attr( "icbcla", class_num ) 259 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) ! strange syntaxe and idea... 260 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) ) ! strange syntaxe and idea... 261 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea... 262 ! for diaprt, we need to define an axis which size can be 1 (default) or 5 (if the file subbasins.nc exists) 263 INQUIRE( FILE = 'subbasins.nc', EXIST = ll_exist ) 264 nbasin = 1 + 4 * COUNT( (/ll_exist/) ) 265 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,nbasin) /) ) 250 266 ENDIF 251 267 ! 252 268 ! automatic definitions of some of the xml attributs 253 IF( TRIM(cdname) == TRIM(crxios_context) ) THEN 254 !set names of the fields in restart file IF using XIOS to read data 255 CALL iom_set_rst_context(.TRUE.) 256 CALL iom_set_rst_vars(rst_rfields) 257 !set which fields are to be read from restart file 258 CALL iom_set_rstr_active() 259 ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 260 !set names of the fields in restart file IF using XIOS to write data 261 CALL iom_set_rst_context(.FALSE.) 262 CALL iom_set_rst_vars(rst_wfields) 263 !set which fields are to be written to a restart file 264 CALL iom_set_rstw_active(fname) 269 IF(llrstr) THEN 270 IF(PRESENT(kdid)) THEN 271 CALL iom_set_rst_context(.TRUE.) 272 !set which fields will be read from restart file 273 CALL iom_set_vars_active(kdid) 274 ELSE 275 CALL ctl_stop( 'iom_init:', 'restart read with XIOS: missing pointer to NETCDF file' ) 276 ENDIF 277 ELSE IF(llrstw) THEN 278 CALL iom_set_rstw_file(iom_file(kdid)%name) 265 279 ELSE 266 280 CALL set_xmlatt 267 281 ENDIF 268 282 ! … … 280 294 END SUBROUTINE iom_init 281 295 282 SUBROUTINE iom_init_closedef 296 SUBROUTINE iom_init_closedef(cdname) 283 297 !!---------------------------------------------------------------------- 284 298 !! *** SUBROUTINE iom_init_closedef *** … … 288 302 !! 289 303 !!---------------------------------------------------------------------- 290 304 CHARACTER(len=*), OPTIONAL, INTENT(IN) :: cdname 291 305 #if defined key_iomput 292 CALL xios_close_context_definition() 293 CALL xios_update_calendar( 0 ) 306 LOGICAL :: llrstw 307 308 llrstw = .FALSE. 309 IF(PRESENT(cdname)) THEN 310 llrstw = (cdname == cw_ocerst_cxt) 311 llrstw = llrstw .OR. (cdname == cw_icerst_cxt) 312 llrstw = llrstw .OR. (cdname == cw_toprst_cxt) 313 llrstw = llrstw .OR. (cdname == cw_sedrst_cxt) 314 ENDIF 315 316 IF( llrstw ) THEN 317 !set names of the fields in restart file IF using XIOS to write data 318 CALL iom_set_rst_context(.FALSE.) 319 CALL xios_close_context_definition() 320 ELSE 321 CALL xios_close_context_definition() 322 CALL xios_update_calendar( 0 ) 323 ENDIF 294 324 #else 295 325 IF( .FALSE. ) WRITE(numout,*) 'iom_init_closedef: should not see this' ! useless statement to avoid compilation warnings … … 298 328 END SUBROUTINE iom_init_closedef 299 329 300 SUBROUTINE iom_set_ rstw_var_active(field)330 SUBROUTINE iom_set_vars_active(idnum) 301 331 !!--------------------------------------------------------------------- 302 !! *** SUBROUTINE iom_set_rstw_var_active *** 303 !! 304 !! ** Purpose : enable variable in restart file when writing with XIOS 332 !! *** SUBROUTINE iom_set_vars_active *** 333 !! 334 !! ** Purpose : define filename in XIOS context for reading file, 335 !! enable variables present in a file for reading with XIOS 336 !! id of the file is assumed to be rrestart. 305 337 !!--------------------------------------------------------------------- 306 CHARACTER(len = *), INTENT(IN) :: field 307 INTEGER :: i 308 LOGICAL :: llis_set 309 CHARACTER(LEN=256) :: clinfo ! info character 338 INTEGER, INTENT(IN) :: idnum 310 339 311 340 #if defined key_iomput 312 llis_set = .FALSE. 313 314 DO i = 1, max_rst_fields 315 IF(TRIM(rst_wfields(i)%vname) == field) THEN 316 rst_wfields(i)%active = .TRUE. 317 llis_set = .TRUE. 318 EXIT 319 ENDIF 320 ENDDO 321 !Warn if variable is not in defined in rst_wfields 322 IF(.NOT.llis_set) THEN 323 WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 324 CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 ) 325 ENDIF 326 #else 327 clinfo = 'iom_set_rstw_var_active: key_iomput is needed to use XIOS restart read/write functionality' 328 CALL ctl_stop('STOP', TRIM(clinfo)) 329 #endif 330 331 END SUBROUTINE iom_set_rstw_var_active 332 333 SUBROUTINE iom_set_rstr_active() 341 INTEGER :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims 342 TYPE(xios_field) :: field_hdl 343 TYPE(xios_file) :: file_hdl 344 TYPE(xios_filegroup) :: filegroup_hdl 345 INTEGER :: dimids(4), jv,i, idim 346 CHARACTER(LEN=256) :: clinfo ! info character 347 INTEGER, ALLOCATABLE :: indimlens(:) 348 CHARACTER(LEN=nf90_max_name), ALLOCATABLE :: indimnames(:) 349 CHARACTER(LEN=nf90_max_name) :: dimname, varname 350 INTEGER :: iln 351 CHARACTER(LEN=lc) :: fname 352 LOGICAL :: lmeta 353 !metadata in restart file for restart read with XIOS 354 INTEGER, PARAMETER :: NMETA = 10 355 CHARACTER(LEN=lc) :: meta(NMETA) 356 357 358 meta(1) = "nav_lat" 359 meta(2) = "nav_lon" 360 meta(3) = "nav_lev" 361 meta(4) = "time_instant" 362 meta(5) = "time_instant_bounds" 363 meta(6) = "time_counter" 364 meta(7) = "time_counter_bounds" 365 meta(8) = "x" 366 meta(9) = "y" 367 meta(10) = "numcat" 368 369 clinfo = ' iom_set_vars_active, file: '//TRIM(iom_file(idnum)%name) 370 371 iln = INDEX( iom_file(idnum)%name, '.nc' ) 372 !XIOS doee not need .nc 373 IF(iln > 0) THEN 374 fname = iom_file(idnum)%name(1:iln-1) 375 ELSE 376 fname = iom_file(idnum)%name 377 ENDIF 378 379 !set name of the restart file and enable available fields 380 CALL xios_get_handle("file_definition", filegroup_hdl ) 381 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 382 CALL xios_set_file_attr( "rrestart", name=fname, type="one_file", & 383 par_access="collective", enabled=.TRUE., mode="read", & 384 output_freq=xios_timestep ) 385 386 CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, ndims, nvars, natts ), clinfo ) 387 ALLOCATE(indimlens(ndims), indimnames(ndims)) 388 CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, unlimitedDimId = unlimitedDimId ), clinfo ) 389 390 DO idim = 1, ndims 391 CALL iom_nf90_check( nf90_inquire_dimension(iom_file(idnum)%nfid, idim, dimname, dimlen ), clinfo ) 392 indimlens(idim) = dimlen 393 indimnames(idim) = dimname 394 ENDDO 395 396 DO jv =1, nvars 397 lmeta = .FALSE. 398 CALL iom_nf90_check( nf90_inquire_variable(iom_file(idnum)%nfid, jv, varname, xtype, ndims, dimids, natts ), clinfo ) 399 DO i = 1, NMETA 400 IF(varname == meta(i)) THEN 401 lmeta = .TRUE. 402 ENDIF 403 ENDDO 404 IF(.NOT.lmeta) THEN 405 CALL xios_add_child(file_hdl, field_hdl, varname) 406 mdims = ndims 407 408 IF(ANY(dimids(1:ndims) == unlimitedDimId)) THEN 409 mdims = mdims - 1 410 ENDIF 411 412 IF(mdims == 3) THEN 413 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 414 domain_ref="grid_N", & 415 axis_ref=iom_axis(indimlens(dimids(mdims))), & 416 prec = 8, operation = "instant" ) 417 ELSEIF(mdims == 2) THEN 418 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 419 domain_ref="grid_N", prec = 8, & 420 operation = "instant" ) 421 ELSEIF(mdims == 1) THEN 422 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 423 axis_ref=iom_axis(indimlens(dimids(mdims))), & 424 prec = 8, operation = "instant" ) 425 ELSEIF(mdims == 0) THEN 426 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 427 scalar_ref = "grid_scalar", prec = 8, & 428 operation = "instant" ) 429 ELSE 430 WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 431 CALL ctl_stop( 'iom_set_vars_active:', ctmp1 ) 432 ENDIF 433 ENDIF 434 ENDDO 435 DEALLOCATE(indimlens, indimnames) 436 #endif 437 END SUBROUTINE iom_set_vars_active 438 439 SUBROUTINE iom_set_rstw_file(cdrst_file) 334 440 !!--------------------------------------------------------------------- 335 !! *** SUBROUTINE iom_set_rstr_active *** 336 !! 337 !! ** Purpose : define file name in XIOS context for reading restart file, 338 !! enable variables present in restart file for reading with XIOS 441 !! *** SUBROUTINE iom_set_rstw_file *** 442 !! 443 !! ** Purpose : define file name in XIOS context for writing restart 339 444 !!--------------------------------------------------------------------- 340 341 !sets enabled = .TRUE. for each field in restart file 342 CHARACTER(len=256) :: rst_file 343 445 CHARACTER(len=*) :: cdrst_file 344 446 #if defined key_iomput 345 TYPE(xios_field) :: field_hdl 346 TYPE(xios_file) :: file_hdl 347 TYPE(xios_filegroup) :: filegroup_hdl 348 INTEGER :: i 349 CHARACTER(lc) :: clpath 350 351 clpath = TRIM(cn_ocerst_indir) 352 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 353 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 354 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 355 ELSE 356 rst_file = TRIM(clpath)//TRIM(Agrif_CFixed())//'_'//TRIM(cn_ocerst_in) 357 ENDIF 447 TYPE(xios_file) :: file_hdl 448 TYPE(xios_filegroup) :: filegroup_hdl 449 358 450 !set name of the restart file and enable available fields 359 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file 360 CALL xios_get_handle("file_definition", filegroup_hdl ) 361 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 362 CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", & 363 par_access="collective", enabled=.TRUE., mode="read", & 364 output_freq=xios_timestep) 365 !define variables for restart context 366 DO i = 1, max_rst_fields 367 IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN 368 IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 369 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname)) 370 SELECT CASE (TRIM(rst_rfields(i)%grid)) 371 CASE ("grid_N_3D") 372 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 373 domain_ref="grid_N", axis_ref="nav_lev", operation = "instant") 374 CASE ("grid_N") 375 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 376 domain_ref="grid_N", operation = "instant") 377 CASE ("grid_vector") 378 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 379 axis_ref="nav_lev", operation = "instant") 380 CASE ("grid_scalar") 381 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 382 scalar_ref = "grid_scalar", operation = "instant") 383 END SELECT 384 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file) 385 ENDIF 386 ENDIF 387 END DO 388 #endif 389 END SUBROUTINE iom_set_rstr_active 390 391 SUBROUTINE iom_set_rstw_core(cdmdl) 392 !!--------------------------------------------------------------------- 393 !! *** SUBROUTINE iom_set_rstw_core *** 394 !! 395 !! ** Purpose : set variables which are always in restart file 396 !!--------------------------------------------------------------------- 397 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS 398 CHARACTER(LEN=256) :: clinfo ! info character 399 #if defined key_iomput 400 IF(cdmdl == "OPA") THEN 401 !from restart.F90 402 CALL iom_set_rstw_var_active("rn_Dt") 403 IF ( .NOT. ln_diurnal_only ) THEN 404 CALL iom_set_rstw_var_active('ub' ) 405 CALL iom_set_rstw_var_active('vb' ) 406 CALL iom_set_rstw_var_active('tb' ) 407 CALL iom_set_rstw_var_active('sb' ) 408 CALL iom_set_rstw_var_active('sshb') 409 ! 410 CALL iom_set_rstw_var_active('un' ) 411 CALL iom_set_rstw_var_active('vn' ) 412 CALL iom_set_rstw_var_active('tn' ) 413 CALL iom_set_rstw_var_active('sn' ) 414 CALL iom_set_rstw_var_active('sshn') 415 CALL iom_set_rstw_var_active('rhop') 416 ENDIF 417 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 418 !from trasbc.F90 419 CALL iom_set_rstw_var_active('sbc_hc_b') 420 CALL iom_set_rstw_var_active('sbc_sc_b') 421 ENDIF 422 #else 423 clinfo = 'iom_set_rstw_core: key_iomput is needed to use XIOS restart read/write functionality' 424 CALL ctl_stop('STOP', TRIM(clinfo)) 425 #endif 426 END SUBROUTINE iom_set_rstw_core 427 428 SUBROUTINE iom_set_rst_vars(fields) 429 !!--------------------------------------------------------------------- 430 !! *** SUBROUTINE iom_set_rst_vars *** 431 !! 432 !! ** Purpose : Fill array fields with the information about all 433 !! possible variables and corresponding grids definition 434 !! for reading/writing restart with XIOS 435 !!--------------------------------------------------------------------- 436 TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields) 437 INTEGER :: i 438 439 i = 0 440 i = i + 1; fields(i)%vname="rn_Dt"; fields(i)%grid="grid_scalar" 441 i = i + 1; fields(i)%vname="un"; fields(i)%grid="grid_N_3D" 442 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D" 443 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D" 444 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D" 445 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D" 446 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D" 447 i = i + 1; fields(i)%vname="sn"; fields(i)%grid="grid_N_3D" 448 i = i + 1; fields(i)%vname="sb"; fields(i)%grid="grid_N_3D" 449 i = i + 1; fields(i)%vname="sshn"; fields(i)%grid="grid_N" 450 i = i + 1; fields(i)%vname="sshb"; fields(i)%grid="grid_N" 451 i = i + 1; fields(i)%vname="rhop"; fields(i)%grid="grid_N_3D" 452 i = i + 1; fields(i)%vname="kt"; fields(i)%grid="grid_scalar" 453 i = i + 1; fields(i)%vname="ndastp"; fields(i)%grid="grid_scalar" 454 i = i + 1; fields(i)%vname="adatrj"; fields(i)%grid="grid_scalar" 455 i = i + 1; fields(i)%vname="utau_b"; fields(i)%grid="grid_N" 456 i = i + 1; fields(i)%vname="vtau_b"; fields(i)%grid="grid_N" 457 i = i + 1; fields(i)%vname="qns_b"; fields(i)%grid="grid_N" 458 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N" 459 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N" 460 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D" 461 i = i + 1; fields(i)%vname="avt_k"; fields(i)%grid="grid_N_3D" 462 i = i + 1; fields(i)%vname="avm_k"; fields(i)%grid="grid_N_3D" 463 i = i + 1; fields(i)%vname="dissl"; fields(i)%grid="grid_N_3D" 464 i = i + 1; fields(i)%vname="sbc_hc_b"; fields(i)%grid="grid_N" 465 i = i + 1; fields(i)%vname="sbc_sc_b"; fields(i)%grid="grid_N" 466 i = i + 1; fields(i)%vname="qsr_hc_b"; fields(i)%grid="grid_N_3D" 467 i = i + 1; fields(i)%vname="fraqsr_1lev"; fields(i)%grid="grid_N" 468 i = i + 1; fields(i)%vname="greenland_icesheet_mass" 469 fields(i)%grid="grid_scalar" 470 i = i + 1; fields(i)%vname="greenland_icesheet_timelapsed" 471 fields(i)%grid="grid_scalar" 472 i = i + 1; fields(i)%vname="greenland_icesheet_mass_roc" 473 fields(i)%grid="grid_scalar" 474 i = i + 1; fields(i)%vname="antarctica_icesheet_mass" 475 fields(i)%grid="grid_scalar" 476 i = i + 1; fields(i)%vname="antarctica_icesheet_timelapsed" 477 fields(i)%grid="grid_scalar" 478 i = i + 1; fields(i)%vname="antarctica_icesheet_mass_roc" 479 fields(i)%grid="grid_scalar" 480 i = i + 1; fields(i)%vname="frc_v"; fields(i)%grid="grid_scalar" 481 i = i + 1; fields(i)%vname="frc_t"; fields(i)%grid="grid_scalar" 482 i = i + 1; fields(i)%vname="frc_s"; fields(i)%grid="grid_scalar" 483 i = i + 1; fields(i)%vname="frc_wn_t"; fields(i)%grid="grid_scalar" 484 i = i + 1; fields(i)%vname="frc_wn_s"; fields(i)%grid="grid_scalar" 485 i = i + 1; fields(i)%vname="ssh_ini"; fields(i)%grid="grid_N" 486 i = i + 1; fields(i)%vname="e3t_ini"; fields(i)%grid="grid_N_3D" 487 i = i + 1; fields(i)%vname="hc_loc_ini"; fields(i)%grid="grid_N_3D" 488 i = i + 1; fields(i)%vname="sc_loc_ini"; fields(i)%grid="grid_N_3D" 489 i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N" 490 i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N" 491 i = i + 1; fields(i)%vname="tilde_e3t_b"; fields(i)%grid="grid_N" 492 i = i + 1; fields(i)%vname="tilde_e3t_n"; fields(i)%grid="grid_N" 493 i = i + 1; fields(i)%vname="hdiv_lf"; fields(i)%grid="grid_N" 494 i = i + 1; fields(i)%vname="ub2_b"; fields(i)%grid="grid_N" 495 i = i + 1; fields(i)%vname="vb2_b"; fields(i)%grid="grid_N" 496 i = i + 1; fields(i)%vname="sshbb_e"; fields(i)%grid="grid_N" 497 i = i + 1; fields(i)%vname="ubb_e"; fields(i)%grid="grid_N" 498 i = i + 1; fields(i)%vname="vbb_e"; fields(i)%grid="grid_N" 499 i = i + 1; fields(i)%vname="sshb_e"; fields(i)%grid="grid_N" 500 i = i + 1; fields(i)%vname="ub_e"; fields(i)%grid="grid_N" 501 i = i + 1; fields(i)%vname="vb_e"; fields(i)%grid="grid_N" 502 i = i + 1; fields(i)%vname="fwf_isf_b"; fields(i)%grid="grid_N" 503 i = i + 1; fields(i)%vname="isf_sc_b"; fields(i)%grid="grid_N" 504 i = i + 1; fields(i)%vname="isf_hc_b"; fields(i)%grid="grid_N" 505 i = i + 1; fields(i)%vname="ssh_ibb"; fields(i)%grid="grid_N" 506 i = i + 1; fields(i)%vname="rnf_b"; fields(i)%grid="grid_N" 507 i = i + 1; fields(i)%vname="rnf_hc_b"; fields(i)%grid="grid_N" 508 i = i + 1; fields(i)%vname="rnf_sc_b"; fields(i)%grid="grid_N" 509 i = i + 1; fields(i)%vname="nn_fsbc"; fields(i)%grid="grid_scalar" 510 i = i + 1; fields(i)%vname="ssu_m"; fields(i)%grid="grid_N" 511 i = i + 1; fields(i)%vname="ssv_m"; fields(i)%grid="grid_N" 512 i = i + 1; fields(i)%vname="sst_m"; fields(i)%grid="grid_N" 513 i = i + 1; fields(i)%vname="sss_m"; fields(i)%grid="grid_N" 514 i = i + 1; fields(i)%vname="ssh_m"; fields(i)%grid="grid_N" 515 i = i + 1; fields(i)%vname="e3t_m"; fields(i)%grid="grid_N" 516 i = i + 1; fields(i)%vname="frq_m"; fields(i)%grid="grid_N" 517 i = i + 1; fields(i)%vname="avmb"; fields(i)%grid="grid_vector" 518 i = i + 1; fields(i)%vname="avtb"; fields(i)%grid="grid_vector" 519 i = i + 1; fields(i)%vname="ub2_i_b"; fields(i)%grid="grid_N" 520 i = i + 1; fields(i)%vname="vb2_i_b"; fields(i)%grid="grid_N" 521 i = i + 1; fields(i)%vname="ntime"; fields(i)%grid="grid_scalar" 522 i = i + 1; fields(i)%vname="Dsst"; fields(i)%grid="grid_scalar" 523 i = i + 1; fields(i)%vname="tmask"; fields(i)%grid="grid_N_3D" 524 i = i + 1; fields(i)%vname="umask"; fields(i)%grid="grid_N_3D" 525 i = i + 1; fields(i)%vname="vmask"; fields(i)%grid="grid_N_3D" 526 i = i + 1; fields(i)%vname="smask"; fields(i)%grid="grid_N_3D" 527 i = i + 1; fields(i)%vname="gdepw_n"; fields(i)%grid="grid_N_3D" 528 i = i + 1; fields(i)%vname="e3t_n"; fields(i)%grid="grid_N_3D" 529 i = i + 1; fields(i)%vname="e3u_n"; fields(i)%grid="grid_N_3D" 530 i = i + 1; fields(i)%vname="e3v_n"; fields(i)%grid="grid_N_3D" 531 i = i + 1; fields(i)%vname="surf_ini"; fields(i)%grid="grid_N" 532 i = i + 1; fields(i)%vname="e3t_b"; fields(i)%grid="grid_N_3D" 533 i = i + 1; fields(i)%vname="hmxl_n"; fields(i)%grid="grid_N_3D" 534 i = i + 1; fields(i)%vname="un_bf"; fields(i)%grid="grid_N" 535 i = i + 1; fields(i)%vname="vn_bf"; fields(i)%grid="grid_N" 536 i = i + 1; fields(i)%vname="hbl"; fields(i)%grid="grid_N" 537 i = i + 1; fields(i)%vname="hbli"; fields(i)%grid="grid_N" 538 i = i + 1; fields(i)%vname="wn"; fields(i)%grid="grid_N_3D" 539 540 IF( i-1 > max_rst_fields) THEN 541 WRITE(ctmp1,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small' 542 CALL ctl_stop( 'iom_set_rst_vars:', ctmp1 ) 543 ENDIF 544 END SUBROUTINE iom_set_rst_vars 545 546 547 SUBROUTINE iom_set_rstw_active(cdrst_file) 451 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ', TRIM(cdrst_file) 452 CALL xios_get_handle("file_definition", filegroup_hdl ) 453 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 454 IF(nxioso.eq.1) THEN 455 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 456 mode="write", output_freq=xios_timestep) 457 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 458 ELSE 459 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 460 mode="write", output_freq=xios_timestep) 461 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 462 ENDIF 463 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 464 #endif 465 END SUBROUTINE iom_set_rstw_file 466 467 468 SUBROUTINE iom_set_rstw_active(sdfield, rd0, rs0, rd1, rs1, rd2, rs2, rd3, rs3) 548 469 !!--------------------------------------------------------------------- 549 470 !! *** SUBROUTINE iom_set_rstw_active *** … … 553 474 !!--------------------------------------------------------------------- 554 475 !sets enabled = .TRUE. for each field in restart file 555 CHARACTER(len=*) :: cdrst_file 476 CHARACTER(len = *), INTENT(IN) :: sdfield 477 REAL(dp), OPTIONAL, INTENT(IN) :: rd0 478 REAL(sp), OPTIONAL, INTENT(IN) :: rs0 479 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rd1 480 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rs1 481 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rd2 482 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rs2 483 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3 484 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rs3 556 485 #if defined key_iomput 557 TYPE(xios_field) :: field_hdl 558 TYPE(xios_file) :: file_hdl 559 TYPE(xios_filegroup) :: filegroup_hdl 560 INTEGER :: i 561 CHARACTER(lc) :: clpath 562 563 !set name of the restart file and enable available fields 564 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file 565 CALL xios_get_handle("file_definition", filegroup_hdl ) 566 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 567 IF(nxioso.eq.1) THEN 568 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 569 mode="write", output_freq=xios_timestep) 570 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 571 ELSE 572 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 573 mode="write", output_freq=xios_timestep) 574 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 575 ENDIF 576 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 486 TYPE(xios_field) :: field_hdl 487 TYPE(xios_file) :: file_hdl 488 489 CALL xios_get_handle("wrestart", file_hdl) 577 490 !define fields for restart context 578 DO i = 1, max_rst_fields 579 IF( rst_wfields(i)%active ) THEN 580 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname)) 581 SELECT CASE (TRIM(rst_wfields(i)%grid)) 582 CASE ("grid_N_3D") 583 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 584 domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant") 585 CASE ("grid_N") 586 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 587 domain_ref="grid_N", prec = 8, operation = "instant") 588 CASE ("grid_vector") 589 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 590 axis_ref="nav_lev", prec = 8, operation = "instant") 591 CASE ("grid_scalar") 592 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 593 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 594 END SELECT 595 ENDIF 596 END DO 491 CALL xios_add_child(file_hdl, field_hdl, sdfield) 492 493 IF(PRESENT(rd3)) THEN 494 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 495 domain_ref = "grid_N", & 496 axis_ref = iom_axis(size(rd3, 3)), & 497 prec = 8, operation = "instant" ) 498 ELSEIF(PRESENT(rs3)) THEN 499 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 500 domain_ref = "grid_N", & 501 axis_ref = iom_axis(size(rd3, 3)), & 502 prec = 4, operation = "instant" ) 503 ELSEIF(PRESENT(rd2)) THEN 504 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 505 domain_ref = "grid_N", prec = 8, & 506 operation = "instant" ) 507 ELSEIF(PRESENT(rs2)) THEN 508 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 509 domain_ref = "grid_N", prec = 4, & 510 operation = "instant" ) 511 ELSEIF(PRESENT(rd1)) THEN 512 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 513 axis_ref = iom_axis(size(rd1, 1)), & 514 prec = 8, operation = "instant" ) 515 ELSEIF(PRESENT(rs1)) THEN 516 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 517 axis_ref = iom_axis(size(rd1, 1)), & 518 prec = 4, operation = "instant" ) 519 ELSEIF(PRESENT(rd0)) THEN 520 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 521 scalar_ref = "grid_scalar", prec = 8, & 522 operation = "instant" ) 523 ELSEIF(PRESENT(rs0)) THEN 524 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 525 scalar_ref = "grid_scalar", prec = 4, & 526 operation = "instant" ) 527 ENDIF 597 528 #endif 598 529 END SUBROUTINE iom_set_rstw_active 599 530 531 FUNCTION iom_axis(idlev) result(axis_ref) 532 !!--------------------------------------------------------------------- 533 !! *** FUNCTION iom_axis *** 534 !! 535 !! ** Purpose : Used for grid definition when XIOS is used to read/write 536 !! restart. Returns axis corresponding to the number of levels 537 !! given as an input variable. Axes are defined in routine 538 !! iom_set_rst_context 539 !!--------------------------------------------------------------------- 540 INTEGER, INTENT(IN) :: idlev 541 CHARACTER(len=lc) :: axis_ref 542 CHARACTER(len=12) :: str 543 IF(idlev == jpk) THEN 544 axis_ref="nav_lev" 545 #if defined key_si3 546 ELSEIF(idlev == jpl) THEN 547 axis_ref="numcat" 548 #endif 549 ELSE 550 write(str, *) idlev 551 CALL ctl_stop( 'iom_axis', 'Definition for axis with '//TRIM(ADJUSTL(str))//' levels missing') 552 ENDIF 553 END FUNCTION iom_axis 554 555 FUNCTION iom_xios_setid(cdname) result(kid) 556 !!--------------------------------------------------------------------- 557 !! *** FUNCTION *** 558 !! 559 !! ** Purpose : this function returns first available id to keep information about file 560 !! sets filename in iom_file structure and sets name 561 !! of XIOS context depending on cdcomp 562 !! corresponds to iom_nf90_open 563 !!--------------------------------------------------------------------- 564 CHARACTER(len=*), INTENT(in ) :: cdname ! File name 565 INTEGER :: kid ! identifier of the opened file 566 INTEGER :: jl 567 568 kid = 0 569 DO jl = jpmax_files, 1, -1 570 IF( iom_file(jl)%nfid == 0 ) kid = jl 571 ENDDO 572 573 iom_file(kid)%name = TRIM(cdname) 574 iom_file(kid)%nfid = 1 575 iom_file(kid)%nvars = 0 576 iom_file(kid)%irec = -1 577 578 END FUNCTION iom_xios_setid 579 600 580 SUBROUTINE iom_set_rst_context(ld_rstr) 601 !!---------------------------------------------------------------------581 !!--------------------------------------------------------------------- 602 582 !! *** SUBROUTINE iom_set_rst_context *** 603 583 !! … … 606 586 !! 607 587 !!--------------------------------------------------------------------- 608 LOGICAL, INTENT(IN) :: ld_rstr 609 !ld_rstr is true for restart context. There is no need to define grid for 610 !restart read, because it's read from file 588 LOGICAL, INTENT(IN) :: ld_rstr 589 INTEGER :: ji 611 590 #if defined key_iomput 612 TYPE(xios_domaingroup) :: domaingroup_hdl613 TYPE(xios_domain) :: domain_hdl614 TYPE(xios_axisgroup) :: axisgroup_hdl615 TYPE(xios_axis) :: axis_hdl616 TYPE(xios_scalar) :: scalar_hdl617 TYPE(xios_scalargroup) :: scalargroup_hdl618 619 CALL xios_get_handle("domain_definition",domaingroup_hdl)620 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")621 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr)622 623 CALL xios_get_handle("axis_definition",axisgroup_hdl)624 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev")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) 601 602 CALL xios_get_handle("axis_definition",axisgroup_hdl) 603 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 625 604 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 626 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 627 CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 628 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 629 630 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 631 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 605 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 606 CALL xios_set_axis_attr( "nav_lev", long_name = "Vertical levels in meters", positive = "down") 607 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 608 #if defined key_si3 609 CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat") 610 CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,wp), ji=1,jpl) /) ) 611 #endif 612 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 613 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 632 614 #endif 633 615 END SUBROUTINE iom_set_rst_context 616 617 618 SUBROUTINE set_xios_context(kdid, cdcont) 619 !!--------------------------------------------------------------------- 620 !! *** SUBROUTINE iom_set_rst_context *** 621 !! 622 !! ** Purpose : set correct XIOS context based on kdid 623 !! 624 !!--------------------------------------------------------------------- 625 INTEGER, INTENT(IN) :: kdid ! Identifier of the file 626 CHARACTER(LEN=lc), INTENT(OUT) :: cdcont ! name of the context for XIOS read/write 627 628 cdcont = "NONE" 629 630 IF(lrxios) THEN 631 IF(kdid == numror) THEN 632 cdcont = cr_ocerst_cxt 633 ELSEIF(kdid == numrir) THEN 634 cdcont = cr_icerst_cxt 635 ELSEIF(kdid == numrtr) THEN 636 cdcont = cr_toprst_cxt 637 ELSEIF(kdid == numrsr) THEN 638 cdcont = cr_sedrst_cxt 639 ENDIF 640 ENDIF 641 642 IF(lwxios) THEN 643 IF(kdid == numrow) THEN 644 cdcont = cw_ocerst_cxt 645 ELSEIF(kdid == numriw) THEN 646 cdcont = cw_icerst_cxt 647 ELSEIF(kdid == numrtw) THEN 648 cdcont = cw_toprst_cxt 649 ELSEIF(kdid == numrsw) THEN 650 cdcont = cw_sedrst_cxt 651 ENDIF 652 ENDIF 653 END SUBROUTINE set_xios_context 654 634 655 635 656 SUBROUTINE iom_swap( cdname ) … … 642 663 #if defined key_iomput 643 664 TYPE(xios_context) :: nemo_hdl 644 645 665 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 646 666 CALL xios_get_handle(TRIM(cdname),nemo_hdl) … … 892 912 !! INTERFACE iom_get 893 913 !!---------------------------------------------------------------------- 894 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime , ldxios)914 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime ) 895 915 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 896 916 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable … … 898 918 REAL(dp) :: ztmp_pvar ! tmp var to read field 899 919 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 900 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart901 920 ! 902 921 INTEGER :: idvar ! variable id … … 906 925 CHARACTER(LEN=100) :: clname ! file name 907 926 CHARACTER(LEN=1) :: cldmspc ! 908 LOGICAL :: llxios 909 ! 910 llxios = .FALSE. 911 IF( PRESENT(ldxios) ) llxios = ldxios 912 913 IF(.NOT.llxios) THEN ! read data using default library 927 CHARACTER(LEN=lc) :: context 928 ! 929 CALL set_xios_context(kiomid, context) 930 931 IF(context == "NONE") THEN ! read data using default library 914 932 itime = 1 915 933 IF( PRESENT(ktime) ) itime = ktime … … 934 952 #if defined key_iomput 935 953 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 936 CALL iom_swap( TRIM(crxios_context))954 CALL iom_swap(context) 937 955 CALL xios_recv_field( trim(cdvar), pvar) 938 CALL iom_swap( TRIM(cxios_context))956 CALL iom_swap(cxios_context) 939 957 #else 940 958 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 944 962 END SUBROUTINE iom_g0d_sp 945 963 946 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime , ldxios)964 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime ) 947 965 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 948 966 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 949 967 REAL(dp) , INTENT( out) :: pvar ! read field 950 968 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 951 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart952 969 ! 953 970 INTEGER :: idvar ! variable id … … 957 974 CHARACTER(LEN=100) :: clname ! file name 958 975 CHARACTER(LEN=1) :: cldmspc ! 959 LOGICAL :: llxios 960 ! 961 llxios = .FALSE. 962 IF( PRESENT(ldxios) ) llxios = ldxios 963 964 IF(.NOT.llxios) THEN ! read data using default library 976 CHARACTER(LEN=lc) :: context 977 ! 978 CALL set_xios_context(kiomid, context) 979 980 IF(context == "NONE") THEN ! read data using default library 965 981 itime = 1 966 982 IF( PRESENT(ktime) ) itime = ktime … … 984 1000 #if defined key_iomput 985 1001 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 986 CALL iom_swap( TRIM(crxios_context))1002 CALL iom_swap(context) 987 1003 CALL xios_recv_field( trim(cdvar), pvar) 988 CALL iom_swap( TRIM(cxios_context))1004 CALL iom_swap(cxios_context) 989 1005 #else 990 1006 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 994 1010 END SUBROUTINE iom_g0d_dp 995 1011 996 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)1012 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 997 1013 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 998 1014 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1003 1019 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1004 1020 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1005 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1006 1021 ! 1007 1022 IF( kiomid > 0 ) THEN … … 1009 1024 ALLOCATE(ztmp_pvar(size(pvar,1))) 1010 1025 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=ztmp_pvar, & 1011 & ktime=ktime, kstart=kstart, kcount=kcount, & 1012 & ldxios=ldxios ) 1026 & ktime=ktime, kstart=kstart, kcount=kcount ) 1013 1027 pvar = ztmp_pvar 1014 1028 DEALLOCATE(ztmp_pvar) … … 1018 1032 1019 1033 1020 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)1034 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 1021 1035 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1022 1036 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1026 1040 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1027 1041 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1028 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1029 1042 ! 1030 1043 IF( kiomid > 0 ) THEN 1031 1044 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 1032 & ktime=ktime, kstart=kstart, kcount=kcount, & 1033 & ldxios=ldxios ) 1045 & ktime=ktime, kstart=kstart, kcount=kcount) 1034 1046 ENDIF 1035 1047 END SUBROUTINE iom_g1d_dp 1036 1048 1037 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1049 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount) 1038 1050 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1039 1051 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1047 1059 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1048 1060 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1049 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1050 1061 ! 1051 1062 IF( kiomid > 0 ) THEN … … 1054 1065 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = ztmp_pvar , ktime = ktime, & 1055 1066 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1056 & kstart = kstart , kcount = kcount , ldxios=ldxios)1067 & kstart = kstart , kcount = kcount ) 1057 1068 pvar = ztmp_pvar 1058 1069 DEALLOCATE(ztmp_pvar) … … 1061 1072 END SUBROUTINE iom_g2d_sp 1062 1073 1063 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1074 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount) 1064 1075 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1065 1076 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1072 1083 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1073 1084 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1074 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1075 1085 ! 1076 1086 IF( kiomid > 0 ) THEN 1077 1087 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = pvar , ktime = ktime, & 1078 1088 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1079 & kstart = kstart , kcount = kcount , ldxios=ldxios)1089 & kstart = kstart , kcount = kcount ) 1080 1090 ENDIF 1081 1091 END SUBROUTINE iom_g2d_dp 1082 1092 1083 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1093 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount ) 1084 1094 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1085 1095 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1093 1103 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1094 1104 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1095 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1096 1105 ! 1097 1106 IF( kiomid > 0 ) THEN … … 1100 1109 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = ztmp_pvar , ktime = ktime, & 1101 1110 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1102 & kstart = kstart , kcount = kcount , ldxios=ldxios)1111 & kstart = kstart , kcount = kcount ) 1103 1112 pvar = ztmp_pvar 1104 1113 DEALLOCATE(ztmp_pvar) … … 1107 1116 END SUBROUTINE iom_g3d_sp 1108 1117 1109 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1118 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount ) 1110 1119 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1111 1120 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1118 1127 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1119 1128 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1120 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1121 1129 ! 1122 1130 IF( kiomid > 0 ) THEN … … 1124 1132 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1125 1133 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1126 & kstart = kstart , kcount = kcount , ldxios=ldxios)1134 & kstart = kstart , kcount = kcount ) 1127 1135 END IF 1128 1136 ENDIF … … 1132 1140 1133 1141 SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime , & 1134 & cd_type, psgn, kfill, kstart, kcount , ldxios)1142 & cd_type, psgn, kfill, kstart, kcount ) 1135 1143 !!----------------------------------------------------------------------- 1136 1144 !! *** ROUTINE iom_get_123d *** … … 1152 1160 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1153 1161 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1154 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart1155 1162 ! 1156 1163 LOGICAL :: llok ! true if ok! 1157 LOGICAL :: llxios ! local definition for XIOS read1158 1164 INTEGER :: jl ! loop on number of dimension 1159 1165 INTEGER :: idom ! type of domain … … 1182 1188 REAL(dp) :: gma, gmi 1183 1189 !--------------------------------------------------------------------- 1184 ! 1190 CHARACTER(LEN=lc) :: context 1191 ! 1192 CALL set_xios_context(kiomid, context) 1185 1193 inlev = -1 1186 1194 IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3) 1187 1195 ! 1188 llxios = .FALSE.1189 IF( PRESENT(ldxios) ) llxios = ldxios1190 !1191 1196 idom = kdom 1192 1197 istop = nstop 1193 1198 ! 1194 IF( .NOT.llxios) THEN1199 IF(context == "NONE") THEN 1195 1200 clname = iom_file(kiomid)%name ! esier to read 1196 1201 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) … … 1359 1364 #if defined key_iomput 1360 1365 !would be good to be able to check which context is active and swap only if current is not restart 1361 CALL iom_swap( TRIM(crxios_context) ) 1366 idvar = iom_varid( kiomid, cdvar ) 1367 CALL iom_swap(context) 1368 zsgn = 1._wp 1369 IF( PRESENT(psgn ) ) zsgn = psgn 1370 cl_type = 'T' 1371 IF( PRESENT(cd_type) ) cl_type = cd_type 1372 1362 1373 IF( PRESENT(pv_r3d) ) THEN 1363 1374 IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 1364 CALL xios_recv_field( trim(cdvar), pv_r3d) 1365 IF(idom /= jpdom_unknown ) CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1375 CALL xios_recv_field( trim(cdvar), pv_r3d(:, :, :)) 1376 IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1377 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill) 1378 ENDIF 1366 1379 ELSEIF( PRESENT(pv_r2d) ) THEN 1367 1380 IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 1368 CALL xios_recv_field( trim(cdvar), pv_r2d) 1369 IF(idom /= jpdom_unknown ) CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1381 CALL xios_recv_field( trim(cdvar), pv_r2d(:, :)) 1382 IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1383 CALL lbc_lnk('iom', pv_r2d, cl_type, zsgn, kfillmode = kfill) 1384 ENDIF 1370 1385 ELSEIF( PRESENT(pv_r1d) ) THEN 1371 1386 IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 1372 1387 CALL xios_recv_field( trim(cdvar), pv_r1d) 1373 1388 ENDIF 1374 CALL iom_swap( TRIM(cxios_context))1389 CALL iom_swap(cxios_context) 1375 1390 #else 1376 1391 istop = istop + 1 … … 1387 1402 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1388 1403 IF( PRESENT(pv_r1d) ) THEN 1389 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf1390 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs1404 IF( zscf /= 1._wp ) pv_r1d(:) = pv_r1d(:) * zscf 1405 IF( zofs /= 0._wp ) pv_r1d(:) = pv_r1d(:) + zofs 1391 1406 ELSEIF( PRESENT(pv_r2d) ) THEN 1392 IF( zscf /= 1. ) pv_r2d(:,:) = pv_r2d(:,:) * zscf1393 IF( zofs /= 0. ) pv_r2d(:,:) = pv_r2d(:,:) + zofs1407 IF( zscf /= 1._wp) pv_r2d(:,:) = pv_r2d(:,:) * zscf 1408 IF( zofs /= 0._wp) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1394 1409 ELSEIF( PRESENT(pv_r3d) ) THEN 1395 IF( zscf /= 1. ) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf1396 IF( zofs /= 0. ) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs1410 IF( zscf /= 1._wp) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 1411 IF( zofs /= 0._wp) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 1397 1412 ENDIF 1398 1413 ! … … 1568 1583 !! INTERFACE iom_rstput 1569 1584 !!---------------------------------------------------------------------- 1570 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1585 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1571 1586 INTEGER , INTENT(in) :: kt ! ocean time-step 1572 1587 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1575 1590 REAL(sp) , INTENT(in) :: pvar ! written field 1576 1591 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1577 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1578 LOGICAL :: llx ! local xios write flag 1579 INTEGER :: ivid ! variable id 1580 1581 llx = .FALSE. 1582 IF(PRESENT(ldxios)) llx = ldxios 1592 ! 1593 LOGICAL :: llx ! local xios write flag 1594 INTEGER :: ivid ! variable id 1595 CHARACTER(LEN=lc) :: context 1596 ! 1597 CALL set_xios_context(kiomid, context) 1598 1599 llx = .NOT. (context == "NONE") 1600 1583 1601 IF( llx ) THEN 1584 1602 #ifdef key_iomput 1585 IF( kt == kwrite ) THEN 1586 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1587 CALL xios_send_field(trim(cdvar), pvar) 1588 ENDIF 1603 IF( kt == kwrite ) THEN 1604 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1605 CALL iom_swap(context) 1606 CALL iom_put(trim(cdvar), pvar) 1607 CALL iom_swap(cxios_context) 1608 ELSE 1609 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1610 CALL iom_swap(context) 1611 CALL iom_set_rstw_active( trim(cdvar), rs0 = pvar ) 1612 CALL iom_swap(cxios_context) 1613 ENDIF 1589 1614 #endif 1590 1615 ELSE … … 1598 1623 END SUBROUTINE iom_rp0d_sp 1599 1624 1600 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1625 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1601 1626 INTEGER , INTENT(in) :: kt ! ocean time-step 1602 1627 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1605 1630 REAL(dp) , INTENT(in) :: pvar ! written field 1606 1631 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1607 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1608 LOGICAL :: llx ! local xios write flag 1609 INTEGER :: ivid ! variable id 1610 1611 llx = .FALSE. 1612 IF(PRESENT(ldxios)) llx = ldxios 1632 ! 1633 LOGICAL :: llx ! local xios write flag 1634 INTEGER :: ivid ! variable id 1635 CHARACTER(LEN=lc) :: context 1636 ! 1637 CALL set_xios_context(kiomid, context) 1638 1639 llx = .NOT. (context == "NONE") 1640 1613 1641 IF( llx ) THEN 1614 1642 #ifdef key_iomput 1615 IF( kt == kwrite ) THEN 1616 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1617 CALL xios_send_field(trim(cdvar), pvar) 1618 ENDIF 1643 IF( kt == kwrite ) THEN 1644 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1645 CALL iom_swap(context) 1646 CALL iom_put(trim(cdvar), pvar) 1647 CALL iom_swap(cxios_context) 1648 ELSE 1649 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1650 CALL iom_swap(context) 1651 CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar ) 1652 CALL iom_swap(cxios_context) 1653 ENDIF 1619 1654 #endif 1620 1655 ELSE … … 1629 1664 1630 1665 1631 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1666 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1632 1667 INTEGER , INTENT(in) :: kt ! ocean time-step 1633 1668 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1636 1671 REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1637 1672 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1638 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1639 LOGICAL :: llx ! local xios write flag 1640 INTEGER :: ivid ! variable id 1641 1642 llx = .FALSE. 1643 IF(PRESENT(ldxios)) llx = ldxios 1673 ! 1674 LOGICAL :: llx ! local xios write flag 1675 INTEGER :: ivid ! variable id 1676 CHARACTER(LEN=lc) :: context 1677 ! 1678 CALL set_xios_context(kiomid, context) 1679 1680 llx = .NOT. (context == "NONE") 1681 1644 1682 IF( llx ) THEN 1645 1683 #ifdef key_iomput 1646 IF( kt == kwrite ) THEN 1647 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1648 CALL xios_send_field(trim(cdvar), pvar) 1649 ENDIF 1684 IF( kt == kwrite ) THEN 1685 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1686 CALL iom_swap(context) 1687 CALL iom_put(trim(cdvar), pvar) 1688 CALL iom_swap(cxios_context) 1689 ELSE 1690 IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D)',trim(cdvar) 1691 CALL iom_swap(context) 1692 CALL iom_set_rstw_active( trim(cdvar), rs1 = pvar ) 1693 CALL iom_swap(cxios_context) 1694 ENDIF 1650 1695 #endif 1651 1696 ELSE … … 1659 1704 END SUBROUTINE iom_rp1d_sp 1660 1705 1661 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1706 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1662 1707 INTEGER , INTENT(in) :: kt ! ocean time-step 1663 1708 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1666 1711 REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1667 1712 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1668 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1669 LOGICAL :: llx ! local xios write flag 1670 INTEGER :: ivid ! variable id 1671 1672 llx = .FALSE. 1673 IF(PRESENT(ldxios)) llx = ldxios 1713 ! 1714 LOGICAL :: llx ! local xios write flag 1715 INTEGER :: ivid ! variable id 1716 CHARACTER(LEN=lc) :: context 1717 ! 1718 CALL set_xios_context(kiomid, context) 1719 1720 llx = .NOT. (context == "NONE") 1721 1674 1722 IF( llx ) THEN 1675 1723 #ifdef key_iomput 1676 IF( kt == kwrite ) THEN 1677 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1678 CALL xios_send_field(trim(cdvar), pvar) 1679 ENDIF 1724 IF( kt == kwrite ) THEN 1725 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1726 CALL iom_swap(context) 1727 CALL iom_put(trim(cdvar), pvar) 1728 CALL iom_swap(cxios_context) 1729 ELSE 1730 IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D)',trim(cdvar) 1731 CALL iom_swap(context) 1732 CALL iom_set_rstw_active( trim(cdvar), rd1 = pvar ) 1733 CALL iom_swap(cxios_context) 1734 ENDIF 1680 1735 #endif 1681 1736 ELSE … … 1690 1745 1691 1746 1692 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1747 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1693 1748 INTEGER , INTENT(in) :: kt ! ocean time-step 1694 1749 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1697 1752 REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1698 1753 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1699 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1700 LOGICAL :: llx 1701 INTEGER :: ivid ! variable id 1702 1703 llx = .FALSE. 1704 IF(PRESENT(ldxios)) llx = ldxios 1754 ! 1755 LOGICAL :: llx 1756 INTEGER :: ivid ! variable id 1757 CHARACTER(LEN=lc) :: context 1758 ! 1759 CALL set_xios_context(kiomid, context) 1760 1761 llx = .NOT. (context == "NONE") 1762 1705 1763 IF( llx ) THEN 1706 1764 #ifdef key_iomput 1707 IF( kt == kwrite ) THEN 1708 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1709 CALL xios_send_field(trim(cdvar), pvar) 1710 ENDIF 1765 IF( kt == kwrite ) THEN 1766 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1767 CALL iom_swap(context) 1768 CALL iom_put(trim(cdvar), pvar) 1769 CALL iom_swap(cxios_context) 1770 ELSE 1771 IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D)',trim(cdvar) 1772 CALL iom_swap(context) 1773 CALL iom_set_rstw_active( trim(cdvar), rs2 = pvar ) 1774 CALL iom_swap(cxios_context) 1775 ENDIF 1711 1776 #endif 1712 1777 ELSE … … 1720 1785 END SUBROUTINE iom_rp2d_sp 1721 1786 1722 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1787 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1723 1788 INTEGER , INTENT(in) :: kt ! ocean time-step 1724 1789 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1727 1792 REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1728 1793 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1729 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1730 LOGICAL :: llx 1731 INTEGER :: ivid ! variable id 1732 1733 llx = .FALSE. 1734 IF(PRESENT(ldxios)) llx = ldxios 1794 ! 1795 LOGICAL :: llx 1796 INTEGER :: ivid ! variable id 1797 CHARACTER(LEN=lc) :: context 1798 ! 1799 CALL set_xios_context(kiomid, context) 1800 1801 llx = .NOT. (context == "NONE") 1802 1735 1803 IF( llx ) THEN 1736 1804 #ifdef key_iomput 1737 IF( kt == kwrite ) THEN 1738 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1739 CALL xios_send_field(trim(cdvar), pvar) 1740 ENDIF 1805 IF( kt == kwrite ) THEN 1806 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1807 CALL iom_swap(context) 1808 CALL iom_put(trim(cdvar), pvar) 1809 CALL iom_swap(cxios_context) 1810 ELSE 1811 IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D)',trim(cdvar) 1812 CALL iom_swap(context) 1813 CALL iom_set_rstw_active( trim(cdvar), rd2 = pvar ) 1814 CALL iom_swap(cxios_context) 1815 ENDIF 1741 1816 #endif 1742 1817 ELSE … … 1751 1826 1752 1827 1753 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1828 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1754 1829 INTEGER , INTENT(in) :: kt ! ocean time-step 1755 1830 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1758 1833 REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1759 1834 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1760 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1761 LOGICAL :: llx ! local xios write flag 1762 INTEGER :: ivid ! variable id 1763 1764 llx = .FALSE. 1765 IF(PRESENT(ldxios)) llx = ldxios 1835 ! 1836 LOGICAL :: llx ! local xios write flag 1837 INTEGER :: ivid ! variable id 1838 CHARACTER(LEN=lc) :: context 1839 ! 1840 CALL set_xios_context(kiomid, context) 1841 1842 llx = .NOT. (context == "NONE") 1843 1766 1844 IF( llx ) THEN 1767 1845 #ifdef key_iomput 1768 IF( kt == kwrite ) THEN 1769 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1770 CALL xios_send_field(trim(cdvar), pvar) 1771 ENDIF 1846 IF( kt == kwrite ) THEN 1847 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1848 CALL iom_swap(context) 1849 CALL iom_put(trim(cdvar), pvar) 1850 CALL iom_swap(cxios_context) 1851 ELSE 1852 IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D)',trim(cdvar) 1853 CALL iom_swap(context) 1854 CALL iom_set_rstw_active( trim(cdvar), rs3 = pvar ) 1855 CALL iom_swap(cxios_context) 1856 ENDIF 1772 1857 #endif 1773 1858 ELSE … … 1781 1866 END SUBROUTINE iom_rp3d_sp 1782 1867 1783 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1868 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1784 1869 INTEGER , INTENT(in) :: kt ! ocean time-step 1785 1870 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1788 1873 REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1789 1874 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1790 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1791 LOGICAL :: llx ! local xios write flag 1792 INTEGER :: ivid ! variable id 1793 1794 llx = .FALSE. 1795 IF(PRESENT(ldxios)) llx = ldxios 1875 ! 1876 LOGICAL :: llx ! local xios write flag 1877 INTEGER :: ivid ! variable id 1878 CHARACTER(LEN=lc) :: context 1879 ! 1880 CALL set_xios_context(kiomid, context) 1881 1882 llx = .NOT. (context == "NONE") 1883 1796 1884 IF( llx ) THEN 1797 1885 #ifdef key_iomput 1798 IF( kt == kwrite ) THEN 1799 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1800 CALL xios_send_field(trim(cdvar), pvar) 1801 ENDIF 1886 IF( kt == kwrite ) THEN 1887 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1888 CALL iom_swap(context) 1889 CALL iom_put(trim(cdvar), pvar) 1890 CALL iom_swap(cxios_context) 1891 ELSE 1892 IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D)',trim(cdvar) 1893 CALL iom_swap(context) 1894 CALL iom_set_rstw_active( trim(cdvar), rd3 = pvar ) 1895 CALL iom_swap(cxios_context) 1896 ENDIF 1802 1897 #endif 1803 1898 ELSE … … 1865 1960 CHARACTER(LEN=*), INTENT(in) :: cdname 1866 1961 REAL(sp) , INTENT(in) :: pfield0d 1867 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson1962 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1868 1963 #if defined key_iomput 1869 1964 !!clem zz(:,:)=pfield0d … … 2145 2240 CALL iom_swap( cdname ) ! swap to cdname context 2146 2241 CALL xios_update_calendar(kt) 2147 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context)) ! return back to nemo context2242 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( cxios_context ) ! return back to nemo context 2148 2243 END SUBROUTINE iom_setkt 2149 2244 … … 2159 2254 CALL iom_swap( cdname ) ! swap to cdname context 2160 2255 CALL xios_context_finalize() ! finalize the context 2161 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context)) ! return back to nemo context2256 IF( cdname /= cxios_context ) CALL iom_swap( cxios_context ) ! return back to nemo context 2162 2257 ENDIF 2163 2258 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/IOM/iom_def.F90
r13558 r14017 9 9 !!---------------------------------------------------------------------- 10 10 USE par_kind 11 USE netcdf 11 12 12 13 IMPLICIT NONE … … 16 17 INTEGER, PARAMETER, PUBLIC :: jpdom_local = 2 !: (Nis0: Nie0 ,Njs0: Nje0 ) 17 18 INTEGER, PARAMETER, PUBLIC :: jpdom_unknown = 3 !: No dimension checking 18 INTEGER, PARAMETER, PUBLIC :: jpdom_auto = 4 !: 19 INTEGER, PARAMETER, PUBLIC :: jpdom_auto = 4 !: 19 20 INTEGER, PARAMETER, PUBLIC :: jpdom_auto_xy = 5 !: Automatically set horizontal dimensions only 20 21 … … 32 33 !$AGRIF_DO_NOT_TREAT 33 34 INTEGER, PUBLIC :: iom_open_init = 0 !: used to initialize iom_file(:)%nfid to 0 34 !XIOS write restart 35 !XIOS write restart 35 36 LOGICAL, PUBLIC :: lwxios = .FALSE. !: write single file restart using XIOS 36 37 INTEGER, PUBLIC :: nxioso = 0 !: type of restart file when writing using XIOS 1 - single, 2 - multiple 37 !XIOS read restart 38 LOGICAL, PUBLIC :: lrxios = .FALSE. !: read single file restart using XIOS 38 !XIOS read restart 39 LOGICAL, PUBLIC :: lrxios = .FALSE. !: read single file restart using XIOS main switch 39 40 LOGICAL, PUBLIC :: lxios_sini = .FALSE. ! is restart in a single file 40 LOGICAL, PUBLIC :: lxios_set = .FALSE. 41 42 41 43 42 44 TYPE, PUBLIC :: file_descriptor … … 48 50 INTEGER :: iduld !: id of the unlimited dimension 49 51 INTEGER :: lenuld !: length of the unlimited dimension (number of records in file) 50 INTEGER :: irec !: writing record position 52 INTEGER :: irec !: writing record position 51 53 CHARACTER(LEN=32) :: uldname !: name of the unlimited dimension 52 54 CHARACTER(LEN=32), DIMENSION(jpmax_vars) :: cn_var !: names of the variables … … 54 56 INTEGER, DIMENSION(jpmax_vars) :: ndims !: number of dimensions of the variables 55 57 LOGICAL, DIMENSION(jpmax_vars) :: luld !: variable using the unlimited dimension 56 INTEGER, DIMENSION(jpmax_dims,jpmax_vars) :: dimsz !: size of variables dimensions 58 INTEGER, DIMENSION(jpmax_dims,jpmax_vars) :: dimsz !: size of variables dimensions 57 59 REAL(kind=wp), DIMENSION(jpmax_vars) :: scf !: scale_factor of the variables 58 60 REAL(kind=wp), DIMENSION(jpmax_vars) :: ofs !: add_offset of the variables 59 61 END TYPE file_descriptor 60 62 TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC :: iom_file !: array containing the info for all opened files 61 INTEGER, PARAMETER, PUBLIC :: max_rst_fields = 95 !: maximum number of restart variables defined in iom_set_rst_vars62 TYPE, PUBLIC :: RST_FIELD63 CHARACTER(len=30) :: vname = "NO_NAME" ! names of variables in restart file64 CHARACTER(len=30) :: grid = "NO_GRID"65 LOGICAL :: active =.FALSE. ! for restart write only: true - write field, false do not write field66 END TYPE RST_FIELD67 63 !$AGRIF_END_DO_NOT_TREAT 68 !69 TYPE(RST_FIELD), PUBLIC, SAVE :: rst_wfields(max_rst_fields), rst_rfields(max_rst_fields)70 64 ! 71 65 !! * Substitutions -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/IOM/iom_nf90.F90
r13286 r14017 31 31 PUBLIC iom_nf90_open , iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_rstput 32 32 PUBLIC iom_nf90_chkatt, iom_nf90_getatt, iom_nf90_putatt 33 PUBLIC iom_nf90_check 33 34 34 35 INTERFACE iom_nf90_get 35 MODULE PROCEDURE iom_nf90_g0d_sp 36 MODULE PROCEDURE iom_nf90_g0d_sp 36 37 MODULE PROCEDURE iom_nf90_g0d_dp, iom_nf90_g123d_dp 37 38 END INTERFACE … … 56 57 INTEGER , INTENT( out) :: kiomid ! nf90 identifier of the opened file 57 58 LOGICAL , INTENT(in ) :: ldwrt ! read or write the file? 58 LOGICAL , INTENT(in ) :: ldok ! check the existence 59 LOGICAL , INTENT(in ) :: ldok ! check the existence 59 60 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! size of the ice/abl third dimension 60 61 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cdcomp ! name of component calling iom_nf90_open … … 84 85 clcomp = cdcomp ! use input value 85 86 ELSE 86 clcomp = 'OCE' ! by default 87 clcomp = 'OCE' ! by default 87 88 ENDIF 88 89 ! … … 119 120 120 121 IF( llclobber ) THEN ; imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER ) 121 ELSE ; imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 122 ELSE ; imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 122 123 ENDIF 123 124 IF( snc4set%luse ) THEN … … 171 172 iom_file(kiomid)%nfid = if90id 172 173 iom_file(kiomid)%nvars = 0 173 iom_file(kiomid)%irec = -1 ! useless for NetCDF files, used to know if the file is in define mode 174 iom_file(kiomid)%irec = -1 ! useless for NetCDF files, used to know if the file is in define mode 174 175 CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 175 176 IF( iom_file(kiomid)%iduld .GE. 0 ) THEN 176 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld, & 177 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld, & 177 178 & name = iom_file(kiomid)%uldname, & 178 179 & len = iom_file(kiomid)%lenuld ), clinfo ) … … 200 201 201 202 202 FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims, lduld ) 203 FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims, lduld ) 203 204 !!----------------------------------------------------------------------- 204 205 !! *** FUNCTION iom_varid *** … … 208 209 INTEGER , INTENT(in ) :: kiomid ! file Identifier 209 210 CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable 210 INTEGER , INTENT(in ) :: kiv ! 211 INTEGER , INTENT(in ) :: kiv ! 211 212 INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of each dimension 212 213 INTEGER , INTENT( out), OPTIONAL :: kndims ! number of dimensions … … 239 240 iom_file(kiomid)%dimsz(:,kiv) = 0 ! reset dimsz in case previously used 240 241 DO ji = 1, i_nvd ! dimensions size 241 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo) 242 IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE. ! unlimited dimension? 242 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo) 243 IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE. ! unlimited dimension? 243 244 END DO 244 245 !---------- Deal with scale_factor and add_offset … … 256 257 END IF 257 258 ! return the simension size 258 IF( PRESENT(kdimsz) ) THEN 259 IF( PRESENT(kdimsz) ) THEN 259 260 IF( i_nvd <= SIZE(kdimsz) ) THEN 260 261 kdimsz(1:i_nvd) = iom_file(kiomid)%dimsz(1:i_nvd,kiv) … … 266 267 IF( PRESENT(kndims) ) kndims = iom_file(kiomid)%ndims(kiv) 267 268 IF( PRESENT( lduld) ) lduld = iom_file(kiomid)%luld(kiv) 268 ELSE 269 ELSE 269 270 iom_nf90_varid = -1 ! variable not found, return error code: -1 270 271 ENDIF … … 322 323 INTEGER , INTENT(in ) :: kvid ! Name of the variable 323 324 INTEGER , INTENT(in ) :: knbdim ! number of dimensions of the variable 324 INTEGER , DIMENSION(:) , INTENT(in ) :: kstart ! start position of the reading in each axis 325 INTEGER , DIMENSION(:) , INTENT(in ) :: kstart ! start position of the reading in each axis 325 326 INTEGER , DIMENSION(:) , INTENT(in ) :: kcount ! number of points to be read in each axis 326 327 INTEGER , INTENT(in ) :: kx1, kx2, ky1, ky2 ! subdomain indexes … … 528 529 !! *** SUBROUTINE iom_nf90_rstput *** 529 530 !! 530 !! ** Purpose : read the time axis cdvar in the file 531 !! ** Purpose : read the time axis cdvar in the file 531 532 !!-------------------------------------------------------------------- 532 533 INTEGER , INTENT(in) :: kt ! ocean time-step 533 534 INTEGER , INTENT(in) :: kwrite ! writing time-step 534 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 535 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 535 536 CHARACTER(len=*) , INTENT(in) :: cdvar ! variable name 536 537 INTEGER , INTENT(in) :: kvid ! variable id … … 543 544 INTEGER :: idims ! number of dimension 544 545 INTEGER :: idvar ! variable id 545 INTEGER :: jd ! dimension loop counter 546 INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes 547 INTEGER, DIMENSION(4) :: idimsz ! dimensions size 546 INTEGER :: jd ! dimension loop counter 547 INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes 548 INTEGER, DIMENSION(4) :: idimsz ! dimensions size 548 549 INTEGER, DIMENSION(4) :: idimid ! dimensions id 549 550 CHARACTER(LEN=256) :: clinfo ! info character … … 677 678 ELSEIF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN 678 679 ix1 = 1 ; ix2 = jpi ; iy1 = 1 ; iy2 = jpj 679 ELSE 680 ELSE 680 681 CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' ) 681 682 ENDIF … … 688 689 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 2, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 689 690 SELECT CASE (iom_file(kiomid)%comp) 690 CASE ('OCE') 691 CASE ('OCE') 691 692 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, gdept_1d ), clinfo ) 692 693 CASE ('ABL') … … 696 697 END SELECT 697 698 ! "wrong" value: to be improved but not really useful... 698 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 4, kt ), clinfo ) 699 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 4, kt ), clinfo ) 699 700 ! update the size of the variable corresponding to the unlimited dimension 700 701 iom_file(kiomid)%dimsz(1, 4) = 1 ! so we don't enter this IF case any more... … … 719 720 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok' 720 721 ENDIF 721 ! 722 ! 722 723 END SUBROUTINE iom_nf90_rp0123d_dp 723 724 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/IOM/prtctl.F90
r13286 r14017 8 8 !!---------------------------------------------------------------------- 9 9 USE dom_oce ! ocean space and time domain variables 10 USE domutl, ONLY : is_tile 10 11 USE in_out_manager ! I/O manager 11 12 USE mppini ! distributed memory computing … … 14 15 IMPLICIT NONE 15 16 PRIVATE 16 17 17 18 INTEGER , DIMENSION( :), ALLOCATABLE :: numprt_oce, numprt_top 18 19 INTEGER , DIMENSION( :), ALLOCATABLE :: nall_ictls, nall_ictle ! first, last indoor index for each i-domain … … 21 22 REAL(wp), DIMENSION( :), ALLOCATABLE :: u_ctl , v_ctl ! previous velocity trend values 22 23 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tra_ctl ! previous top trend values 23 ! 24 ! 24 25 PUBLIC prt_ctl ! called by all subroutines 25 26 PUBLIC prt_ctl_info ! called by all subroutines 26 27 PUBLIC prt_ctl_init ! called by nemogcm.F90 and prt_ctl_trc_init 27 28 29 !! * Substitutions 30 # include "do_loop_substitute.h90" 28 31 !!---------------------------------------------------------------------- 29 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 30 !! $Id$ 33 !! $Id$ 31 34 !! Software governed by the CeCILL license (see ./LICENSE) 32 35 !!---------------------------------------------------------------------- … … 35 38 SUBROUTINE prt_ctl (tab2d_1, tab3d_1, tab4d_1, tab2d_2, tab3d_2, mask1, mask2, & 36 39 & clinfo, clinfo1, clinfo2, clinfo3, kdim ) 37 !!---------------------------------------------------------------------- 38 !! *** ROUTINE prt_ctl *** 39 !! 40 !! ** Purpose : - print sum control of 2D or 3D arrays over the same area 41 !! in mono and mpp case. This way can be usefull when 42 !! debugging a new parametrization in mono or mpp. 43 !! 44 !! ** Method : 2 possibilities exist when setting the sn_cfctl%prtctl parameter to 45 !! .true. in the ocean namelist: 46 !! - to debug a MPI run .vs. a mono-processor one; 47 !! the control print will be done over each sub-domain. 48 !! The nictl[se] and njctl[se] parameters in the namelist must 49 !! be set to zero and [ij]splt to the corresponding splitted 50 !! domain in MPI along respectively i-, j- directions. 51 !! - to debug a mono-processor run over the whole domain/a specific area; 52 !! in the first case the nictl[se] and njctl[se] parameters must be set 53 !! to zero else to the indices of the area to be controled. In both cases 54 !! isplt and jsplt must be set to 1. 55 !! - All arguments of the above calling sequence are optional so their 56 !! name must be explicitly typed if used. For instance if the 3D 57 !! array tn(:,:,:) must be passed through the prt_ctl subroutine, 58 !! it must look like: CALL prt_ctl(tab3d_1=tn). 59 !! 60 !! tab2d_1 : first 2D array 61 !! tab3d_1 : first 3D array 62 !! tab4d_1 : first 4D array 63 !! mask1 : mask (3D) to apply to the tab[23]d_1 array 64 !! clinfo1 : information about the tab[23]d_1 array 65 !! tab2d_2 : second 2D array 66 !! tab3d_2 : second 3D array 67 !! mask2 : mask (3D) to apply to the tab[23]d_2 array 68 !! clinfo2 : information about the tab[23]d_2 array 69 !! kdim : k- direction for 3D arrays 70 !! clinfo3 : additional information 71 !!---------------------------------------------------------------------- 40 !! 72 41 REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_1 73 42 REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: tab3d_1 … … 83 52 INTEGER , INTENT(in), OPTIONAL :: kdim 84 53 ! 54 INTEGER :: itab2d_1, itab3d_1, itab4d_1, itab2d_2, itab3d_2 55 !! 56 IF( PRESENT(tab2d_1) ) THEN ; itab2d_1 = is_tile(tab2d_1) ; ELSE ; itab2d_1 = 0 ; ENDIF 57 IF( PRESENT(tab3d_1) ) THEN ; itab3d_1 = is_tile(tab3d_1) ; ELSE ; itab3d_1 = 0 ; ENDIF 58 IF( PRESENT(tab4d_1) ) THEN ; itab4d_1 = is_tile(tab4d_1) ; ELSE ; itab4d_1 = 0 ; ENDIF 59 IF( PRESENT(tab2d_2) ) THEN ; itab2d_2 = is_tile(tab2d_2) ; ELSE ; itab2d_2 = 0 ; ENDIF 60 IF( PRESENT(tab3d_2) ) THEN ; itab3d_2 = is_tile(tab3d_2) ; ELSE ; itab3d_2 = 0 ; ENDIF 61 62 CALL prt_ctl_t (tab2d_1, itab2d_1, tab3d_1, itab3d_1, tab4d_1, itab4d_1, tab2d_2, itab2d_2, tab3d_2, itab3d_2, & 63 & mask1, mask2, clinfo, clinfo1, clinfo2, clinfo3, kdim ) 64 END SUBROUTINE prt_ctl 65 66 67 SUBROUTINE prt_ctl_t (tab2d_1, ktab2d_1, tab3d_1, ktab3d_1, tab4d_1, ktab4d_1, tab2d_2, ktab2d_2, tab3d_2, ktab3d_2, & 68 & mask1, mask2, clinfo, clinfo1, clinfo2, clinfo3, kdim ) 69 !!---------------------------------------------------------------------- 70 !! *** ROUTINE prt_ctl *** 71 !! 72 !! ** Purpose : - print sum control of 2D or 3D arrays over the same area 73 !! in mono and mpp case. This way can be usefull when 74 !! debugging a new parametrization in mono or mpp. 75 !! 76 !! ** Method : 2 possibilities exist when setting the sn_cfctl%prtctl parameter to 77 !! .true. in the ocean namelist: 78 !! - to debug a MPI run .vs. a mono-processor one; 79 !! the control print will be done over each sub-domain. 80 !! The nictl[se] and njctl[se] parameters in the namelist must 81 !! be set to zero and [ij]splt to the corresponding splitted 82 !! domain in MPI along respectively i-, j- directions. 83 !! - to debug a mono-processor run over the whole domain/a specific area; 84 !! in the first case the nictl[se] and njctl[se] parameters must be set 85 !! to zero else to the indices of the area to be controled. In both cases 86 !! isplt and jsplt must be set to 1. 87 !! - All arguments of the above calling sequence are optional so their 88 !! name must be explicitly typed if used. For instance if the 3D 89 !! array tn(:,:,:) must be passed through the prt_ctl subroutine, 90 !! it must look like: CALL prt_ctl(tab3d_1=tn). 91 !! 92 !! tab2d_1 : first 2D array 93 !! tab3d_1 : first 3D array 94 !! tab4d_1 : first 4D array 95 !! mask1 : mask (3D) to apply to the tab[23]d_1 array 96 !! clinfo1 : information about the tab[23]d_1 array 97 !! tab2d_2 : second 2D array 98 !! tab3d_2 : second 3D array 99 !! mask2 : mask (3D) to apply to the tab[23]d_2 array 100 !! clinfo2 : information about the tab[23]d_2 array 101 !! kdim : k- direction for 3D arrays 102 !! clinfo3 : additional information 103 !!---------------------------------------------------------------------- 104 INTEGER , INTENT(in) :: ktab2d_1, ktab3d_1, ktab4d_1, ktab2d_2, ktab3d_2 105 REAL(wp), DIMENSION(A2D_T(ktab2d_1)) , INTENT(in), OPTIONAL :: tab2d_1 106 REAL(wp), DIMENSION(A2D_T(ktab3d_1),:) , INTENT(in), OPTIONAL :: tab3d_1 107 REAL(wp), DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL :: tab4d_1 108 REAL(wp), DIMENSION(A2D_T(ktab2d_2)) , INTENT(in), OPTIONAL :: tab2d_2 109 REAL(wp), DIMENSION(A2D_T(ktab3d_2),:) , INTENT(in), OPTIONAL :: tab3d_2 110 REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask1 111 REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask2 112 CHARACTER(len=*), DIMENSION(:) , INTENT(in), OPTIONAL :: clinfo ! information about the tab3d array 113 CHARACTER(len=*) , INTENT(in), OPTIONAL :: clinfo1 114 CHARACTER(len=*) , INTENT(in), OPTIONAL :: clinfo2 115 CHARACTER(len=*) , INTENT(in), OPTIONAL :: clinfo3 116 INTEGER , INTENT(in), OPTIONAL :: kdim 117 ! 85 118 CHARACTER(len=30) :: cl1, cl2 86 119 INTEGER :: jn, jl, kdir … … 90 123 !!---------------------------------------------------------------------- 91 124 ! 92 ! Arrays, scalars initialization 125 ! Arrays, scalars initialization 93 126 cl1 = '' 94 127 cl2 = '' … … 106 139 107 140 ! define shoter names... 108 iis = nall_ictls(jl)109 iie = nall_ictle(jl)110 jjs = nall_jctls(jl)111 jje = nall_jctle(jl)141 iis = MAX( nall_ictls(jl), ntsi ) 142 iie = MIN( nall_ictle(jl), ntei ) 143 jjs = MAX( nall_jctls(jl), ntsj ) 144 jje = MIN( nall_jctle(jl), ntej ) 112 145 113 146 IF( PRESENT(clinfo) ) THEN ; inum = numprt_top(jl) … … 115 148 ENDIF 116 149 117 DO jn = 1, itra 118 119 IF( PRESENT(clinfo3) ) THEN 120 IF ( clinfo3 == 'tra-ta' ) THEN 121 zvctl1 = t_ctl(jl) 122 ELSEIF( clinfo3 == 'tra' ) THEN 123 zvctl1 = t_ctl(jl) 124 zvctl2 = s_ctl(jl) 125 ELSEIF( clinfo3 == 'dyn' ) THEN 126 zvctl1 = u_ctl(jl) 127 zvctl2 = v_ctl(jl) 150 ! Compute the sum control only where the tile domain and control print area overlap 151 IF( iie >= iis .AND. jje >= jjs ) THEN 152 DO jn = 1, itra 153 154 IF( PRESENT(clinfo3) ) THEN 155 IF ( clinfo3 == 'tra-ta' ) THEN 156 zvctl1 = t_ctl(jl) 157 ELSEIF( clinfo3 == 'tra' ) THEN 158 zvctl1 = t_ctl(jl) 159 zvctl2 = s_ctl(jl) 160 ELSEIF( clinfo3 == 'dyn' ) THEN 161 zvctl1 = u_ctl(jl) 162 zvctl2 = v_ctl(jl) 163 ELSE 164 zvctl1 = tra_ctl(jn,jl) 165 ENDIF 166 ENDIF 167 168 ! 2D arrays 169 IF( PRESENT(tab2d_1) ) THEN 170 IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(iis:iie,jjs:jje,1) ) 171 ELSE ; zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) ) 172 ENDIF 173 ENDIF 174 IF( PRESENT(tab2d_2) ) THEN 175 IF( PRESENT(mask2) ) THEN ; zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(iis:iie,jjs:jje,1) ) 176 ELSE ; zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) ) 177 ENDIF 178 ENDIF 179 180 ! 3D arrays 181 IF( PRESENT(tab3d_1) ) THEN 182 IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(iis:iie,jjs:jje,1:kdir) ) 183 ELSE ; zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) ) 184 ENDIF 185 ENDIF 186 IF( PRESENT(tab3d_2) ) THEN 187 IF( PRESENT(mask2) ) THEN ; zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(iis:iie,jjs:jje,1:kdir) ) 188 ELSE ; zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) ) 189 ENDIF 190 ENDIF 191 192 ! 4D arrays 193 IF( PRESENT(tab4d_1) ) THEN 194 IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(iis:iie,jjs:jje,1:kdir) ) 195 ELSE ; zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) ) 196 ENDIF 197 ENDIF 198 199 ! Print the result 200 IF( PRESENT(clinfo ) ) cl1 = clinfo(jn) 201 IF( PRESENT(clinfo3) ) THEN 202 ! 203 IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 204 WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2 205 ELSE 206 WRITE(inum, "(3x,a,' : ',D23.16 )") cl1, zsum1 - zvctl1 207 ENDIF 208 ! 209 SELECT CASE( clinfo3 ) 210 CASE ( 'tra-ta' ) 211 t_ctl(jl) = zsum1 212 CASE ( 'tra' ) 213 t_ctl(jl) = zsum1 214 s_ctl(jl) = zsum2 215 CASE ( 'dyn' ) 216 u_ctl(jl) = zsum1 217 v_ctl(jl) = zsum2 218 CASE default 219 tra_ctl(jn,jl) = zsum1 220 END SELECT 221 ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 222 WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2 128 223 ELSE 129 zvctl1 = tra_ctl(jn,jl) 130 ENDIF 131 ENDIF 132 133 ! 2D arrays 134 IF( PRESENT(tab2d_1) ) THEN 135 IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(iis:iie,jjs:jje,1) ) 136 ELSE ; zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) ) 137 ENDIF 138 ENDIF 139 IF( PRESENT(tab2d_2) ) THEN 140 IF( PRESENT(mask2) ) THEN ; zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(iis:iie,jjs:jje,1) ) 141 ELSE ; zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) ) 142 ENDIF 143 ENDIF 144 145 ! 3D arrays 146 IF( PRESENT(tab3d_1) ) THEN 147 IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(iis:iie,jjs:jje,1:kdir) ) 148 ELSE ; zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) ) 149 ENDIF 150 ENDIF 151 IF( PRESENT(tab3d_2) ) THEN 152 IF( PRESENT(mask2) ) THEN ; zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(iis:iie,jjs:jje,1:kdir) ) 153 ELSE ; zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) ) 154 ENDIF 155 ENDIF 156 157 ! 4D arrays 158 IF( PRESENT(tab4d_1) ) THEN 159 IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(iis:iie,jjs:jje,1:kdir) ) 160 ELSE ; zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) ) 161 ENDIF 162 ENDIF 163 164 ! Print the result 165 IF( PRESENT(clinfo ) ) cl1 = clinfo(jn) 166 IF( PRESENT(clinfo3) ) THEN 167 ! 168 IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 169 WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2 170 ELSE 171 WRITE(inum, "(3x,a,' : ',D23.16 )") cl1, zsum1 - zvctl1 172 ENDIF 173 ! 174 SELECT CASE( clinfo3 ) 175 CASE ( 'tra-ta' ) 176 t_ctl(jl) = zsum1 177 CASE ( 'tra' ) 178 t_ctl(jl) = zsum1 179 s_ctl(jl) = zsum2 180 CASE ( 'dyn' ) 181 u_ctl(jl) = zsum1 182 v_ctl(jl) = zsum2 183 CASE default 184 tra_ctl(jn,jl) = zsum1 185 END SELECT 186 ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 187 WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2 188 ELSE 189 WRITE(inum, "(3x,a,' : ',D23.16 )") cl1, zsum1 190 ENDIF 191 192 END DO 224 WRITE(inum, "(3x,a,' : ',D23.16 )") cl1, zsum1 225 ENDIF 226 227 END DO 228 ENDIF 193 229 END DO 194 230 ! 195 END SUBROUTINE prt_ctl 231 END SUBROUTINE prt_ctl_t 196 232 197 233 … … 274 310 WRITE(numout,*) '~~~~~~~~~~~~~' 275 311 ENDIF 276 IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 ) THEN ! print control done over the default area 312 IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 ) THEN ! print control done over the default area 277 313 nn_isplt = MAX(1, nn_isplt) ! number of processors following i-direction 278 314 nn_jsplt = MAX(1, nn_jsplt) ! number of processors following j-direction … … 355 391 ENDIF 356 392 357 ! Initialization 393 ! Initialization 358 394 IF( clcomp == 'oce' ) THEN 359 395 ALLOCATE( t_ctl(ijsplt), s_ctl(ijsplt), u_ctl(ijsplt), v_ctl(ijsplt), numprt_oce(ijsplt) ) … … 388 424 WRITE(inum,*) 389 425 WRITE(inum,'(19x,a20)') cl_run 390 WRITE(inum,*) 426 WRITE(inum,*) 391 427 WRITE(inum,*) 'prt_ctl : Sum control indices' 392 428 WRITE(inum,*) '~~~~~~~' -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/IOM/restart.F90
r13286 r14017 18 18 !! rst_read : read the ocean restart file 19 19 !!---------------------------------------------------------------------- 20 USE oce ! ocean dynamics and tracers 20 USE oce ! ocean dynamics and tracers 21 21 USE dom_oce ! ocean space and time domain 22 USE sbc_ice ! only lk_si3 22 USE sbc_ice ! only lk_si3 23 23 USE phycst ! physical constants 24 24 USE eosbn2 ! equation of state (eos bn2 routine) … … 48 48 !!--------------------------------------------------------------------- 49 49 !! *** ROUTINE rst_opn *** 50 !! 51 !! ** Purpose : + initialization (should be read in the namelist) of nitrst 50 !! 51 !! ** Purpose : + initialization (should be read in the namelist) of nitrst 52 52 !! + open the restart when we are one time step before nitrst 53 53 !! - restart header is defined when kt = nitrst-1 … … 65 65 ! 66 66 IF( kt == nit000 ) THEN ! default definitions 67 lrst_oce = .FALSE. 67 lrst_oce = .FALSE. 68 68 IF( ln_rst_list ) THEN 69 69 nrst_lst = 1 … … 73 73 ENDIF 74 74 ENDIF 75 75 76 76 IF( .NOT. ln_rst_list .AND. nn_stock == -1 ) RETURN ! we will never do any restart 77 77 78 78 ! frequency-based restart dumping (nn_stock) 79 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN 79 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN 80 80 ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 81 81 nitrst = kt + nn_stock - 1 ! define the next value of nitrst for restart writing … … 86 86 ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 87 87 IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 88 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 88 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 89 89 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 90 90 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst … … 110 110 ELSE 111 111 #if defined key_iomput 112 cw xios_context = "rstw_"//TRIM(ADJUSTL(clkt))112 cw_ocerst_cxt = "rstw_"//TRIM(ADJUSTL(clkt)) 113 113 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 114 114 clpname = clname 115 115 ELSE 116 clpname = TRIM(Agrif_CFixed())//"_"//clname 116 clpname = TRIM(Agrif_CFixed())//"_"//clname 117 117 ENDIF 118 CALL iom_init( cwxios_context, TRIM(clpath)//TRIM(clpname), .false.)119 CALL xios_update_calendar(nitrst)118 numrow = iom_xios_setid(TRIM(clpath)//TRIM(clpname)) 119 CALL iom_init( cw_ocerst_cxt, kdid = numrow, ld_closedef = .false. ) 120 120 CALL iom_swap( cxios_context ) 121 121 #else … … 134 134 !!--------------------------------------------------------------------- 135 135 !! *** ROUTINE rstwrite *** 136 !! 136 !! 137 137 !! ** Purpose : Write restart fields in NetCDF format 138 138 !! … … 143 143 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 144 144 !!---------------------------------------------------------------------- 145 IF(lwxios) CALL iom_swap( cwxios_context ) 146 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rn_Dt , ldxios = lwxios) ! dynamics time step 147 CALL iom_delay_rst( 'WRITE', 'OCE', numrow ) ! save only ocean delayed global communication variables 145 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rn_Dt ) ! dynamics time step 146 IF(.NOT.lwxios) CALL iom_delay_rst( 'WRITE', 'OCE', numrow ) ! save only ocean delayed global communication variables 148 147 149 148 IF ( .NOT. ln_diurnal_only ) THEN 150 CALL iom_rstput( kt, nitrst, numrow, 'ub' , uu(:,:,: ,Kbb) , ldxios = lwxios) ! before fields151 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vv(:,:,: ,Kbb) , ldxios = lwxios)152 CALL iom_rstput( kt, nitrst, numrow, 'tb' , ts(:,:,:,jp_tem,Kbb) , ldxios = lwxios)153 CALL iom_rstput( kt, nitrst, numrow, 'sb' , ts(:,:,:,jp_sal,Kbb) , ldxios = lwxios)154 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , ssh(:,: ,Kbb), ldxios = lwxios)149 CALL iom_rstput( kt, nitrst, numrow, 'ub' , uu(:,:,: ,Kbb) ) ! before fields 150 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vv(:,:,: ,Kbb) ) 151 CALL iom_rstput( kt, nitrst, numrow, 'tb' , ts(:,:,:,jp_tem,Kbb) ) 152 CALL iom_rstput( kt, nitrst, numrow, 'sb' , ts(:,:,:,jp_sal,Kbb) ) 153 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , ssh(:,: ,Kbb)) 155 154 ! 156 CALL iom_rstput( kt, nitrst, numrow, 'un' , uu(:,:,: ,Kmm), ldxios = lwxios ) ! now fields 157 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vv(:,:,: ,Kmm), ldxios = lwxios ) 158 CALL iom_rstput( kt, nitrst, numrow, 'tn' , ts(:,:,:,jp_tem,Kmm), ldxios = lwxios ) 159 CALL iom_rstput( kt, nitrst, numrow, 'sn' , ts(:,:,:,jp_sal,Kmm), ldxios = lwxios ) 160 CALL iom_rstput( kt, nitrst, numrow, 'sshn' ,ssh(:,: ,Kmm), ldxios = lwxios ) 161 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop, ldxios = lwxios ) 162 ENDIF 163 164 IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios ) 165 IF(lwxios) CALL iom_swap( cxios_context ) 155 CALL iom_rstput( kt, nitrst, numrow, 'un' , uu(:,:,: ,Kmm) ) ! now fields 156 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vv(:,:,: ,Kmm) ) 157 CALL iom_rstput( kt, nitrst, numrow, 'tn' , ts(:,:,:,jp_tem,Kmm) ) 158 CALL iom_rstput( kt, nitrst, numrow, 'sn' , ts(:,:,:,jp_sal,Kmm) ) 159 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , ssh(:,: ,Kmm)) 160 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop ) 161 ENDIF 162 163 IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst ) 166 164 IF( kt == nitrst ) THEN 167 165 IF(.NOT.lwxios) THEN 168 166 CALL iom_close( numrow ) ! close the restart file (only at last time step) 169 167 ELSE 170 CALL iom_context_finalize( cwxios_context ) 168 CALL iom_context_finalize( cw_ocerst_cxt ) 169 iom_file(numrow)%nfid = 0 170 numrow = 0 171 171 ENDIF 172 172 !!gm IF( .NOT. lk_trdmld ) lrst_oce = .FALSE. … … 183 183 184 184 SUBROUTINE rst_read_open 185 !!---------------------------------------------------------------------- 185 !!---------------------------------------------------------------------- 186 186 !! *** ROUTINE rst_read_open *** 187 !! 187 !! 188 188 !! ** Purpose : Open read files for NetCDF restart 189 !! 189 !! 190 190 !! ** Method : Use a non-zero, positive value of numror to assess whether or not 191 191 !! the file has already been opened 192 192 !!---------------------------------------------------------------------- 193 LOGICAL :: llok 194 CHARACTER(lc) :: clpath ! full path to ocean output restart file 193 LOGICAL :: llok 194 CHARACTER(len=lc) :: clpath ! full path to ocean output restart file 195 CHARACTER(len=lc+2) :: clpname ! file name including agrif prefix 195 196 !!---------------------------------------------------------------------- 196 197 ! … … 209 210 ! can handle checking if variable is in the restart file (there will be no need to open 210 211 ! restart) 211 IF(.NOT.lxios_set) lrxios = lrxios.AND.lxios_sini 212 lrxios = lrxios.AND.lxios_sini 213 212 214 IF( lrxios) THEN 213 crxios_context = 'nemo_rst' 214 IF( .NOT.lxios_set ) THEN 215 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 216 CALL iom_init( crxios_context ) 217 lxios_set = .TRUE. 218 ENDIF 219 ENDIF 220 IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN 221 CALL iom_init( crxios_context ) 222 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 223 lxios_set = .TRUE. 224 ENDIF 215 cr_ocerst_cxt = 'oce_rst' 216 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 217 ! IF( TRIM(Agrif_CFixed()) == '0' ) THEN 218 ! clpname = cn_ocerst_in 219 ! ELSE 220 ! clpname = TRIM(Agrif_CFixed())//"_"//cn_ocerst_in 221 ! ENDIF 222 CALL iom_init( cr_ocerst_cxt, kdid = numror, ld_closedef = .TRUE. ) 223 CALL iom_swap( cxios_context ) 224 ENDIF 225 225 226 ENDIF 226 227 … … 229 230 230 231 SUBROUTINE rst_read( Kbb, Kmm ) 231 !!---------------------------------------------------------------------- 232 !!---------------------------------------------------------------------- 232 233 !! *** ROUTINE rst_read *** 233 !! 234 !! 234 235 !! ** Purpose : Read files for NetCDF restart 235 !! 236 !! 236 237 !! ** Method : Read in restart.nc file fields which are necessary for restart 237 238 !!---------------------------------------------------------------------- … … 246 247 ! Check dynamics and tracer time-step consistency and force Euler restart if changed 247 248 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN 248 CALL iom_get( numror, 'rdt', zrdt , ldxios = lrxios)249 CALL iom_get( numror, 'rdt', zrdt ) 249 250 IF( zrdt /= rn_Dt ) THEN 250 251 IF(lwp) WRITE( numout,*) … … 256 257 ENDIF 257 258 258 CALL iom_delay_rst( 'READ', 'OCE', numror ) ! read only ocean delayed global communication variables259 260 ! Diurnal DSST 261 IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst , ldxios = lrxios )262 IF ( ln_diurnal_only ) THEN 259 IF(.NOT.lrxios ) CALL iom_delay_rst( 'READ', 'OCE', numror ) ! read only ocean delayed global communication variables 260 261 ! Diurnal DSST 262 IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst ) 263 IF ( ln_diurnal_only ) THEN 263 264 IF(lwp) WRITE( numout, * ) & 264 & "rst_read:- ln_diurnal_only set, setting rhop=rho0" 265 & "rst_read:- ln_diurnal_only set, setting rhop=rho0" 265 266 rhop = rho0 266 CALL iom_get( numror, jpdom_auto, 'tn' , w3d , ldxios = lrxios )267 CALL iom_get( numror, jpdom_auto, 'tn' , w3d ) 267 268 ts(:,:,1,jp_tem,Kmm) = w3d(:,:,1) 268 RETURN 269 ENDIF 270 269 RETURN 270 ENDIF 271 271 272 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 272 273 ! before fields 273 CALL iom_get( numror, jpdom_auto, 'ub' , uu(:,:,: ,Kbb), ldxios = lrxios,cd_type = 'U', psgn = -1._wp )274 CALL iom_get( numror, jpdom_auto, 'vb' , vv(:,:,: ,Kbb), ldxios = lrxios,cd_type = 'V', psgn = -1._wp )275 CALL iom_get( numror, jpdom_auto, 'tb' , ts(:,:,:,jp_tem,Kbb) , ldxios = lrxios)276 CALL iom_get( numror, jpdom_auto, 'sb' , ts(:,:,:,jp_sal,Kbb) , ldxios = lrxios)277 CALL iom_get( numror, jpdom_auto, 'sshb' ,ssh(:,: ,Kbb) , ldxios = lrxios)274 CALL iom_get( numror, jpdom_auto, 'ub' , uu(:,:,: ,Kbb), cd_type = 'U', psgn = -1._wp ) 275 CALL iom_get( numror, jpdom_auto, 'vb' , vv(:,:,: ,Kbb), cd_type = 'V', psgn = -1._wp ) 276 CALL iom_get( numror, jpdom_auto, 'tb' , ts(:,:,:,jp_tem,Kbb) ) 277 CALL iom_get( numror, jpdom_auto, 'sb' , ts(:,:,:,jp_sal,Kbb) ) 278 CALL iom_get( numror, jpdom_auto, 'sshb' ,ssh(:,: ,Kbb) ) 278 279 ELSE 279 280 l_1st_euler = .TRUE. ! before field not found, forced euler 1st time-step … … 281 282 ! 282 283 ! now fields 283 CALL iom_get( numror, jpdom_auto, 'un' , uu(:,:,: ,Kmm), ldxios = lrxios,cd_type = 'U', psgn = -1._wp )284 CALL iom_get( numror, jpdom_auto, 'vn' , vv(:,:,: ,Kmm), ldxios = lrxios,cd_type = 'V', psgn = -1._wp )285 CALL iom_get( numror, jpdom_auto, 'tn' , ts(:,:,:,jp_tem,Kmm) , ldxios = lrxios)286 CALL iom_get( numror, jpdom_auto, 'sn' , ts(:,:,:,jp_sal,Kmm) , ldxios = lrxios)287 CALL iom_get( numror, jpdom_auto, 'sshn' ,ssh(:,: ,Kmm) , ldxios = lrxios)284 CALL iom_get( numror, jpdom_auto, 'un' , uu(:,:,: ,Kmm), cd_type = 'U', psgn = -1._wp ) 285 CALL iom_get( numror, jpdom_auto, 'vn' , vv(:,:,: ,Kmm), cd_type = 'V', psgn = -1._wp ) 286 CALL iom_get( numror, jpdom_auto, 'tn' , ts(:,:,:,jp_tem,Kmm) ) 287 CALL iom_get( numror, jpdom_auto, 'sn' , ts(:,:,:,jp_sal,Kmm) ) 288 CALL iom_get( numror, jpdom_auto, 'sshn' ,ssh(:,: ,Kmm) ) 288 289 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 289 CALL iom_get( numror, jpdom_auto, 'rhop' , rhop , ldxios = lrxios) ! now potential density290 CALL iom_get( numror, jpdom_auto, 'rhop' , rhop ) ! now potential density 290 291 ELSE 291 CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) ) 292 ENDIF 293 ! 294 IF( l_1st_euler ) THEN ! Euler restart 292 CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) ) 293 ENDIF 294 ! 295 IF( l_1st_euler ) THEN ! Euler restart 295 296 ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm) ! all before fields set to now values 296 297 uu (:,:,: ,Kbb) = uu (:,:,: ,Kmm)
Note: See TracChangeset
for help on using the changeset viewer.
