- Timestamp:
- 2017-10-26T13:15:54+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8600_xios_write/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8661 r8662 109 109 CHARACTER(len=lc) :: clname 110 110 INTEGER :: ji, jkmin 111 LOGICAL :: l rst_context ! is context related to restart111 LOGICAL :: llrst_context ! is context related to restart 112 112 ! 113 113 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds … … 120 120 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 121 121 CALL iom_swap( cdname ) 122 l rst_context = (TRIM(cdname) == TRIM(wxios_context))122 llrst_context = (TRIM(cdname) == TRIM(cwxios_context)) 123 123 124 124 ! Calendar type is now defined in xml file … … 133 133 134 134 ! horizontal grid definition 135 IF(.NOT.l rst_context) CALL set_scalar135 IF(.NOT.llrst_context) CALL set_scalar 136 136 137 137 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN … … 165 165 CALL dom_grid_glo ! Return to parent grid domain 166 166 ! 167 IF( ln_cfmeta .AND. TRIM(cdname) .NE. TRIM( wxios_context)) THEN ! Add additional grid metadata167 IF( ln_cfmeta .AND. TRIM(cdname) .NE. TRIM(cwxios_context)) THEN ! Add additional grid metadata 168 168 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 169 169 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) … … 178 178 179 179 ! vertical grid definition 180 IF(.NOT.l rst_context) THEN180 IF(.NOT.llrst_context) THEN 181 181 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 182 182 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) … … 209 209 ENDIF 210 210 ! automatic definitions of some of the xml attributs 211 IF( TRIM(cdname) == TRIM( wxios_context) ) THEN211 IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 212 212 !set names of the fields in restart file IF using XIOS to read/write data 213 213 CALL iom_set_rst_context() … … 235 235 CHARACTER(len = *), INTENT(IN) :: field 236 236 INTEGER :: i 237 LOGICAL :: is_set238 239 is_set = .FALSE.237 LOGICAL :: llis_set 238 239 llis_set = .FALSE. 240 240 241 241 DO i = 1, max_rst_fields 242 242 IF(TRIM(rst_wfields(i)%vname) == field) THEN 243 243 rst_wfields(i)%active = .TRUE. 244 is_set = .TRUE.244 llis_set = .TRUE. 245 245 EXIT 246 246 ENDIF 247 247 ENDDO 248 248 !Warn if variable is not in defined in rst_wfields 249 IF(.NOT.is_set) THEN 250 IF(lwp) write(numout,*) 'E R R O R in iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 249 IF(.NOT.llis_set) THEN 250 IF(lwp) THEN 251 write(numout,cform_err) 252 write(numout,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 253 ENDIF 251 254 nstop = nstop + 1 252 255 ENDIF … … 399 402 400 403 401 SUBROUTINE iom_set_rstw_active( rst_file)404 SUBROUTINE iom_set_rstw_active(cdrst_file) 402 405 !sets enabled = .TRUE. for each field in restart file 403 CHARACTER(len=*) :: rst_file406 CHARACTER(len=*) :: cdrst_file 404 407 #if defined key_iomput 405 408 TYPE(xios_field) :: field_hdl … … 410 413 411 414 !set name of the restart file and enable available fields 412 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',rst_file415 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file 413 416 CALL xios_get_handle("file_definition", filegroup_hdl ) 414 417 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 415 IF( wxioso.eq.1) THEN418 IF(nxioso.eq.1) THEN 416 419 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 417 420 mode="write", output_freq=xios_timestep) 418 if(lwp) write(numout,*) 'OPEN ', trim( rst_file), ' in one_file mode'421 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 419 422 ELSE 420 423 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 421 424 mode="write", output_freq=xios_timestep) 422 if(lwp) write(numout,*) 'OPEN ', trim( rst_file), ' in multiple_file mode'425 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 423 426 ENDIF 424 CALL xios_set_file_attr( "wrestart", name=trim( rst_file))427 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 425 428 !defin files for restart context 426 429 DO i = 1, max_rst_fields … … 1369 1372 !! INTERFACE iom_rstput 1370 1373 !!---------------------------------------------------------------------- 1371 SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, l xios )1374 SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1372 1375 INTEGER , INTENT(in) :: kt ! ocean time-step 1373 1376 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1376 1379 REAL(wp) , INTENT(in) :: pvar ! written field 1377 1380 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1378 LOGICAL, OPTIONAL :: l xios ! xios write flag1379 LOGICAL :: l x ! local xios write flag1381 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1382 LOGICAL :: llx ! local xios write flag 1380 1383 INTEGER :: ivid ! variable id 1381 1384 1382 l x = .FALSE.1383 IF(PRESENT(l xios)) lx = lxios1384 IF( l x ) THEN1385 llx = .FALSE. 1386 IF(PRESENT(ldxios)) llx = ldxios 1387 IF( llx ) THEN 1385 1388 #ifdef key_iomput 1386 1389 IF( kt == kwrite ) THEN … … 1403 1406 END SUBROUTINE iom_rp0d 1404 1407 1405 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, l xios )1408 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1406 1409 INTEGER , INTENT(in) :: kt ! ocean time-step 1407 1410 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1410 1413 REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1411 1414 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1412 LOGICAL, OPTIONAL :: l xios ! xios write flag1413 LOGICAL :: l x ! local xios write flag1415 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1416 LOGICAL :: llx ! local xios write flag 1414 1417 INTEGER :: ivid ! variable id 1415 1418 1416 l x = .FALSE.1417 IF(PRESENT(l xios)) lx = lxios1418 IF( l x ) THEN1419 llx = .FALSE. 1420 IF(PRESENT(ldxios)) llx = ldxios 1421 IF( llx ) THEN 1419 1422 #ifdef key_iomput 1420 1423 IF( kt == kwrite ) THEN … … 1437 1440 END SUBROUTINE iom_rp1d 1438 1441 1439 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, l xios )1442 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1440 1443 INTEGER , INTENT(in) :: kt ! ocean time-step 1441 1444 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1444 1447 REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1445 1448 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1446 LOGICAL, OPTIONAL :: l xios ! xios write flag1447 LOGICAL :: l x1449 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1450 LOGICAL :: llx 1448 1451 INTEGER :: ivid ! variable id 1449 1452 1450 l x = .FALSE.1451 IF(PRESENT(l xios)) lx = lxios1452 IF( l x ) THEN1453 llx = .FALSE. 1454 IF(PRESENT(ldxios)) llx = ldxios 1455 IF( llx ) THEN 1453 1456 #ifdef key_iomput 1454 1457 IF( kt == kwrite ) THEN … … 1471 1474 END SUBROUTINE iom_rp2d 1472 1475 1473 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, l xios )1476 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1474 1477 INTEGER , INTENT(in) :: kt ! ocean time-step 1475 1478 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1478 1481 REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1479 1482 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1480 LOGICAL, OPTIONAL :: l xios ! xios write flag1481 LOGICAL :: l x ! local xios write flag1483 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1484 LOGICAL :: llx ! local xios write flag 1482 1485 INTEGER :: ivid ! variable id 1483 1486 1484 l x = .FALSE.1485 IF(PRESENT(l xios)) lx = lxios1486 IF( l x ) THEN1487 llx = .FALSE. 1488 IF(PRESENT(ldxios)) llx = ldxios 1489 IF( llx ) THEN 1487 1490 #ifdef key_iomput 1488 1491 IF( kt == kwrite ) THEN … … 1692 1695 1693 1696 1694 SUBROUTINE set_grid( cdgrd, plon, plat, l xios )1697 SUBROUTINE set_grid( cdgrd, plon, plat, ldxios ) 1695 1698 !!---------------------------------------------------------------------- 1696 1699 !! *** ROUTINE set_grid *** … … 1705 1708 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1706 1709 INTEGER :: ni,nj 1707 LOGICAL, INTENT(IN) :: l xios1710 LOGICAL, INTENT(IN) :: ldxios 1708 1711 1709 1712 ni=nlei-nldi+1 ; nj=nlej-nldj+1 … … 1711 1714 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1712 1715 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1713 if(.NOT.l xios) CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), &1716 if(.NOT.ldxios) CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & 1714 1717 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1715 1718 1716 IF ( ln_mskland.AND.(.NOT.l xios) ) THEN1719 IF ( ln_mskland.AND.(.NOT.ldxios) ) THEN 1717 1720 ! mask land points, keep values on coast line -> specific mask for U, V and W points 1718 1721 SELECT CASE ( cdgrd )
Note: See TracChangeset
for help on using the changeset viewer.
