Changeset 10425 for NEMO/trunk/src/OCE/IOM/iom.F90
- Timestamp:
- 2018-12-19T22:54:16+01:00 (5 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/IOM/iom.F90 (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/IOM/iom.F90
r10361 r10425 58 58 #endif 59 59 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get 60 PUBLIC iom_ getatt, iom_putatt, iom_gettime, iom_rstput, iom_put60 PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_gettime, iom_rstput, iom_delay_rst, iom_put 61 61 PUBLIC iom_use, iom_context_finalize 62 62 … … 75 75 END INTERFACE 76 76 INTERFACE iom_getatt 77 MODULE PROCEDURE iom_g0d_iatt, iom_g 0d_ratt, iom_g0d_catt77 MODULE PROCEDURE iom_g0d_iatt, iom_g1d_iatt, iom_g0d_ratt, iom_g1d_ratt, iom_g0d_catt 78 78 END INTERFACE 79 79 INTERFACE iom_putatt 80 MODULE PROCEDURE iom_p0d_iatt, iom_p 0d_ratt, iom_p0d_catt80 MODULE PROCEDURE iom_p0d_iatt, iom_p1d_iatt, iom_p0d_ratt, iom_p1d_ratt, iom_p0d_catt 81 81 END INTERFACE 82 82 INTERFACE iom_rstput … … 286 286 !Warn if variable is not in defined in rst_wfields 287 287 IF(.NOT.llis_set) THEN 288 IF(lwp) THEN 289 write(numout,cform_err) 290 write(numout,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 291 ENDIF 292 nstop = nstop + 1 288 WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 289 CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 ) 293 290 ENDIF 294 291 #else … … 518 515 519 516 IF( i-1 > max_rst_fields) THEN 520 IF(lwp) write(numout,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small'521 nstop = nstop + 1517 WRITE(ctmp1,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small' 518 CALL ctl_stop( 'iom_set_rst_vars:', ctmp1 ) 522 519 ENDIF 523 520 END SUBROUTINE iom_set_rst_vars … … 634 631 635 632 636 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib,ldstop, ldiof, kdlev )633 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev ) 637 634 !!--------------------------------------------------------------------- 638 635 !! *** SUBROUTINE iom_open *** … … 644 641 LOGICAL , INTENT(in ), OPTIONAL :: ldwrt ! open in write modeb (default = .FALSE.) 645 642 INTEGER , INTENT(in ), OPTIONAL :: kdom ! Type of domain to be written (default = jpdom_local_noovlap) 646 INTEGER , INTENT(in ), OPTIONAL :: kiolib ! library used to open the file (default = jpnf90)647 643 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 648 644 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) … … 659 655 LOGICAL :: llstop ! local definition of ldstop 660 656 LOGICAL :: lliof ! local definition of ldiof 661 INTEGER :: iolib ! library do we use to open the file662 657 INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits) 663 658 INTEGER :: iln, ils ! lengths of character … … 692 687 ELSE ; llstop = .TRUE. 693 688 ENDIF 694 ! what library do we use to open the file?695 IF( PRESENT(kiolib) ) THEN ; iolib = kiolib696 ELSE ; iolib = jpnf90697 ENDIF698 689 ! are we using interpolation on the fly? 699 690 IF( PRESENT(ldiof) ) THEN ; lliof = ldiof … … 713 704 ENDIF 714 705 ! which suffix should we use? 715 SELECT CASE (iolib) 716 CASE (jpnf90 ) ; clsuffix = '.nc' 717 CASE DEFAULT ; clsuffix = '' 718 CALL ctl_stop( TRIM(clinfo), 'accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) 719 END SELECT 706 clsuffix = '.nc' 720 707 ! Add the suffix if needed 721 708 iln = LEN_TRIM(clname) … … 802 789 ENDIF 803 790 IF( istop == nstop ) THEN ! no error within this routine 804 SELECT CASE (iolib) 805 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 806 CASE DEFAULT 807 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) 808 END SELECT 791 CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 809 792 ENDIF 810 793 ! … … 839 822 DO jf = i_s, i_e 840 823 IF( iom_file(jf)%nfid > 0 ) THEN 841 SELECT CASE (iom_file(jf)%iolib) 842 CASE (jpnf90 ) ; CALL iom_nf90_close( jf ) 843 CASE DEFAULT 844 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 845 END SELECT 824 CALL iom_nf90_close( jf ) 846 825 iom_file(jf)%nfid = 0 ! free the id 847 826 IF( PRESENT(kiomid) ) kiomid = 0 ! return 0 as id to specify that the file was closed … … 896 875 iiv = iiv + 1 897 876 IF( iiv <= jpmax_vars ) THEN 898 SELECT CASE (iom_file(kiomid)%iolib) 899 CASE (jpnf90 ) ; iom_varid = iom_nf90_varid ( kiomid, cdvar, iiv, kdimsz, kndims ) 900 CASE DEFAULT 901 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 902 END SELECT 877 iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims ) 903 878 ELSE 904 879 CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name, & 905 & 880 & 'increase the parameter jpmax_vars') 906 881 ENDIF 907 882 IF( llstop .AND. iom_varid == -1 ) CALL ctl_stop( TRIM(clinfo)//' not found' ) … … 962 937 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 963 938 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 964 SELECT CASE (iom_file(kiomid)%iolib) 965 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 966 CASE DEFAULT 967 CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 968 END SELECT 939 CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 969 940 ENDIF 970 941 ENDIF … … 976 947 CALL iom_swap( TRIM(cxios_context) ) 977 948 #else 978 nstop = nstop + 1979 clinfo = 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar)949 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) 950 CALL ctl_stop( 'iom_g0d', ctmp1 ) 980 951 #endif 981 952 ENDIF … … 1122 1093 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 1123 1094 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 1124 ENDIF1125 IF( luse_jattr ) THEN1126 SELECT CASE (iom_file(kiomid)%iolib)1127 CASE (jpnf90 )1128 ! Ok1129 CASE DEFAULT1130 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' )1131 END SELECT1132 1095 ENDIF 1133 1096 … … 1301 1264 ENDIF 1302 1265 1303 SELECT CASE (iom_file(kiomid)%iolib) 1304 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 1305 & pv_r1d, pv_r2d, pv_r3d ) 1306 CASE DEFAULT 1307 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1308 END SELECT 1266 CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d, pv_r3d ) 1309 1267 1310 1268 IF( istop == nstop ) THEN ! no additional errors until this point... … … 1313 1271 !--- overlap areas and extra hallows (mpp) 1314 1272 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1315 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )1273 CALL lbc_lnk( 'iom', pv_r2d,'Z',-999.,'no0' ) 1316 1274 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1317 1275 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1318 1276 IF( icnt(3) == inlev ) THEN 1319 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )1277 CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' ) 1320 1278 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1321 1279 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO … … 1342 1300 CALL xios_recv_field( trim(cdvar), pv_r3d) 1343 1301 IF(idom /= jpdom_unknown ) then 1344 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )1302 CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' ) 1345 1303 ENDIF 1346 1304 ELSEIF( PRESENT(pv_r2d) ) THEN … … 1349 1307 CALL xios_recv_field( trim(cdvar), pv_r2d) 1350 1308 IF(idom /= jpdom_unknown ) THEN 1351 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0')1309 CALL lbc_lnk('iom', pv_r2d,'Z',-999.,'no0') 1352 1310 ENDIF 1353 1311 ELSEIF( PRESENT(pv_r1d) ) THEN … … 1364 1322 !some final adjustments 1365 1323 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1366 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. )1367 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. )1324 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( 'iom', pv_r2d,'Z',1. ) 1325 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( 'iom', pv_r3d,'Z',1. ) 1368 1326 1369 1327 !--- Apply scale_factor and offset … … 1422 1380 IF( iom_file(kiomid)%luld(idvar) ) THEN 1423 1381 IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN 1424 SELECT CASE (iom_file(kiomid)%iolib) 1425 CASE (jpnf90 ) ; CALL iom_nf90_gettime( kiomid, idvar, ptime, cdunits, cdcalendar ) 1426 CASE DEFAULT 1427 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1428 END SELECT 1382 CALL iom_nf90_gettime( kiomid, idvar, ptime, cdunits, cdcalendar ) 1429 1383 ELSE 1430 1384 WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar) … … 1444 1398 END SUBROUTINE iom_gettime 1445 1399 1400 !!---------------------------------------------------------------------- 1401 !! INTERFACE iom_chkatt 1402 !!---------------------------------------------------------------------- 1403 SUBROUTINE iom_chkatt( kiomid, cdatt, llok, ksize, cdvar ) 1404 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1405 CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute 1406 LOGICAL , INTENT( out) :: llok ! Error code 1407 INTEGER , INTENT( out), OPTIONAL :: ksize ! Size of the attribute array 1408 CHARACTER(len=*), INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1409 ! 1410 IF( kiomid > 0 ) THEN 1411 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_chkatt( kiomid, cdatt, llok, ksize=ksize, cdvar=cdvar ) 1412 ENDIF 1413 ! 1414 END SUBROUTINE iom_chkatt 1446 1415 1447 1416 !!---------------------------------------------------------------------- 1448 1417 !! INTERFACE iom_getatt 1449 1418 !!---------------------------------------------------------------------- 1450 SUBROUTINE iom_g0d_iatt( kiomid, cdatt, pvar, cdvar )1451 INTEGER , INTENT(in ):: kiomid ! Identifier of the file1452 CHARACTER(len=*) , INTENT(in ):: cdatt ! Name of the attribute1453 INTEGER , INTENT( out) :: pvar! read field1454 CHARACTER(len=*) , INTENT(in ), OPTIONAL:: cdvar ! Name of the variable1419 SUBROUTINE iom_g0d_iatt( kiomid, cdatt, katt0d, cdvar ) 1420 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1421 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1422 INTEGER , INTENT( out) :: katt0d ! read field 1423 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1455 1424 ! 1456 1425 IF( kiomid > 0 ) THEN 1457 IF( iom_file(kiomid)%nfid > 0 ) THEN 1458 SELECT CASE (iom_file(kiomid)%iolib) 1459 CASE (jpnf90 ) ; IF( PRESENT(cdvar) ) THEN 1460 CALL iom_nf90_getatt( kiomid, cdatt, pvar, cdvar=cdvar ) 1461 ELSE 1462 CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 1463 ENDIF 1464 CASE DEFAULT 1465 CALL ctl_stop( 'iom_g0d_iatt: accepted IO library is only jpnf90' ) 1466 END SELECT 1467 ENDIF 1426 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, katt0d = katt0d, cdvar=cdvar ) 1468 1427 ENDIF 1469 1428 END SUBROUTINE iom_g0d_iatt 1470 1429 1471 SUBROUTINE iom_g 0d_ratt( kiomid, cdatt, pvar, cdvar )1472 INTEGER , INTENT(in ):: kiomid ! Identifier of the file1473 CHARACTER(len=*) , INTENT(in ):: cdatt ! Name of the attribute1474 REAL(wp) , INTENT( out) :: pvar ! writtenfield1475 CHARACTER(len=*) , INTENT(in ), OPTIONAL:: cdvar ! Name of the variable1430 SUBROUTINE iom_g1d_iatt( kiomid, cdatt, katt1d, cdvar ) 1431 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1432 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1433 INTEGER, DIMENSION(:) , INTENT( out) :: katt1d ! read field 1434 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1476 1435 ! 1477 1436 IF( kiomid > 0 ) THEN 1478 IF( iom_file(kiomid)%nfid > 0 ) THEN 1479 SELECT CASE (iom_file(kiomid)%iolib) 1480 CASE (jpnf90 ) ; IF( PRESENT(cdvar) ) THEN 1481 CALL iom_nf90_getatt( kiomid, cdatt, pvar, cdvar=cdvar ) 1482 ELSE 1483 CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 1484 ENDIF 1485 CASE DEFAULT 1486 CALL ctl_stop( 'iom_g0d_ratt: accepted IO library is only jpnf90' ) 1487 END SELECT 1488 ENDIF 1437 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, katt1d = katt1d, cdvar=cdvar ) 1438 ENDIF 1439 END SUBROUTINE iom_g1d_iatt 1440 1441 SUBROUTINE iom_g0d_ratt( kiomid, cdatt, patt0d, cdvar ) 1442 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1443 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1444 REAL(wp) , INTENT( out) :: patt0d ! read field 1445 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1446 ! 1447 IF( kiomid > 0 ) THEN 1448 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, patt0d = patt0d, cdvar=cdvar ) 1489 1449 ENDIF 1490 1450 END SUBROUTINE iom_g0d_ratt 1491 1451 1492 SUBROUTINE iom_g 0d_catt( kiomid, cdatt, pvar, cdvar )1493 INTEGER , INTENT(in ):: kiomid ! Identifier of the file1494 CHARACTER(len=*) , INTENT(in ):: cdatt ! Name of the attribute1495 CHARACTER(len=*), INTENT( out) :: pvar ! writtenfield1496 CHARACTER(len=*) , INTENT(in ), OPTIONAL:: cdvar ! Name of the variable1452 SUBROUTINE iom_g1d_ratt( kiomid, cdatt, patt1d, cdvar ) 1453 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1454 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1455 REAL(wp), DIMENSION(:), INTENT( out) :: patt1d ! read field 1456 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1497 1457 ! 1498 1458 IF( kiomid > 0 ) THEN 1499 IF( iom_file(kiomid)%nfid > 0 ) THEN 1500 SELECT CASE (iom_file(kiomid)%iolib) 1501 CASE (jpnf90 ) ; IF( PRESENT(cdvar) ) THEN 1502 CALL iom_nf90_getatt( kiomid, cdatt, pvar, cdvar=cdvar ) 1503 ELSE 1504 CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 1505 ENDIF 1506 CASE DEFAULT 1507 CALL ctl_stop( 'iom_g0d_ratt: accepted IO library is only jpnf90' ) 1508 END SELECT 1509 ENDIF 1459 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, patt1d = patt1d, cdvar=cdvar ) 1460 ENDIF 1461 END SUBROUTINE iom_g1d_ratt 1462 1463 SUBROUTINE iom_g0d_catt( kiomid, cdatt, cdatt0d, cdvar ) 1464 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1465 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1466 CHARACTER(len=*) , INTENT( out) :: cdatt0d ! read field 1467 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1468 ! 1469 IF( kiomid > 0 ) THEN 1470 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar ) 1510 1471 ENDIF 1511 1472 END SUBROUTINE iom_g0d_catt 1473 1512 1474 1513 1475 !!---------------------------------------------------------------------- 1514 1476 !! INTERFACE iom_putatt 1515 1477 !!---------------------------------------------------------------------- 1516 SUBROUTINE iom_p0d_iatt( kiomid, cdatt, pvar, cdvar )1517 INTEGER , INTENT(in ):: kiomid ! Identifier of the file1518 CHARACTER(len=*) , INTENT(in ):: cdatt ! Name of the attribute1519 INTEGER , INTENT(in ) :: pvar ! writefield1520 CHARACTER(len=*) , INTENT(in ), OPTIONAL:: cdvar ! Name of the variable1478 SUBROUTINE iom_p0d_iatt( kiomid, cdatt, katt0d, cdvar ) 1479 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1480 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1481 INTEGER , INTENT(in ) :: katt0d ! written field 1482 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1521 1483 ! 1522 1484 IF( kiomid > 0 ) THEN 1523 IF( iom_file(kiomid)%nfid > 0 ) THEN 1524 SELECT CASE (iom_file(kiomid)%iolib) 1525 CASE (jpnf90 ) ; IF( PRESENT(cdvar) ) THEN 1526 CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar ) 1527 ELSE 1528 CALL iom_nf90_putatt( kiomid, cdatt, pvar ) 1529 ENDIF 1530 CASE DEFAULT 1531 CALL ctl_stop( 'iom_p0d_iatt: accepted IO library is only jpnf90' ) 1532 END SELECT 1533 ENDIF 1485 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, katt0d = katt0d, cdvar=cdvar ) 1534 1486 ENDIF 1535 1487 END SUBROUTINE iom_p0d_iatt 1536 1488 1537 SUBROUTINE iom_p 0d_ratt( kiomid, cdatt, pvar, cdvar )1538 INTEGER , INTENT(in ):: kiomid ! Identifier of the file1539 CHARACTER(len=*) , INTENT(in ):: cdatt ! Name of the attribute1540 REAL(wp) , INTENT(in ) :: pvar ! writefield1541 CHARACTER(len=*) , INTENT(in ), OPTIONAL:: cdvar ! Name of the variable1489 SUBROUTINE iom_p1d_iatt( kiomid, cdatt, katt1d, cdvar ) 1490 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1491 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1492 INTEGER, DIMENSION(:) , INTENT(in ) :: katt1d ! written field 1493 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1542 1494 ! 1543 1495 IF( kiomid > 0 ) THEN 1544 IF( iom_file(kiomid)%nfid > 0 ) THEN 1545 SELECT CASE (iom_file(kiomid)%iolib) 1546 CASE (jpnf90 ) ; IF( PRESENT(cdvar) ) THEN 1547 CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar ) 1548 ELSE 1549 CALL iom_nf90_putatt( kiomid, cdatt, pvar ) 1550 ENDIF 1551 CASE DEFAULT 1552 CALL ctl_stop( 'iom_p0d_ratt: accepted IO library is only jpnf90' ) 1553 END SELECT 1554 ENDIF 1496 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, katt1d = katt1d, cdvar=cdvar ) 1497 ENDIF 1498 END SUBROUTINE iom_p1d_iatt 1499 1500 SUBROUTINE iom_p0d_ratt( kiomid, cdatt, patt0d, cdvar ) 1501 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1502 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1503 REAL(wp) , INTENT(in ) :: patt0d ! written field 1504 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1505 ! 1506 IF( kiomid > 0 ) THEN 1507 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, patt0d = patt0d, cdvar=cdvar ) 1555 1508 ENDIF 1556 1509 END SUBROUTINE iom_p0d_ratt 1557 1510 1558 SUBROUTINE iom_p 0d_catt( kiomid, cdatt, pvar, cdvar )1559 INTEGER , INTENT(in ):: kiomid ! Identifier of the file1560 CHARACTER(len=*) , INTENT(in ):: cdatt ! Name of the attribute1561 CHARACTER(len=*), INTENT(in ) :: pvar ! writefield1562 CHARACTER(len=*) , INTENT(in ), OPTIONAL:: cdvar ! Name of the variable1511 SUBROUTINE iom_p1d_ratt( kiomid, cdatt, patt1d, cdvar ) 1512 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1513 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1514 REAL(wp), DIMENSION(:), INTENT(in ) :: patt1d ! written field 1515 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1563 1516 ! 1564 1517 IF( kiomid > 0 ) THEN 1565 IF( iom_file(kiomid)%nfid > 0 ) THEN 1566 SELECT CASE (iom_file(kiomid)%iolib) 1567 CASE (jpnf90 ) ; IF( PRESENT(cdvar) ) THEN 1568 CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar ) 1569 ELSE 1570 CALL iom_nf90_putatt( kiomid, cdatt, pvar ) 1571 ENDIF 1572 CASE DEFAULT 1573 CALL ctl_stop( 'iom_p0d_ratt: accepted IO library is only jpnf90' ) 1574 END SELECT 1575 ENDIF 1518 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, patt1d = patt1d, cdvar=cdvar ) 1519 ENDIF 1520 END SUBROUTINE iom_p1d_ratt 1521 1522 SUBROUTINE iom_p0d_catt( kiomid, cdatt, cdatt0d, cdvar ) 1523 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1524 CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute 1525 CHARACTER(len=*) , INTENT(in ) :: cdatt0d ! written field 1526 CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1527 ! 1528 IF( kiomid > 0 ) THEN 1529 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar ) 1576 1530 ENDIF 1577 1531 END SUBROUTINE iom_p0d_catt 1532 1578 1533 1579 1534 !!---------------------------------------------------------------------- … … 1604 1559 IF( iom_file(kiomid)%nfid > 0 ) THEN 1605 1560 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1606 SELECT CASE (iom_file(kiomid)%iolib) 1607 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1608 CASE DEFAULT 1609 CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1610 END SELECT 1561 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1611 1562 ENDIF 1612 1563 ENDIF … … 1638 1589 IF( iom_file(kiomid)%nfid > 0 ) THEN 1639 1590 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1640 SELECT CASE (iom_file(kiomid)%iolib) 1641 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1642 CASE DEFAULT 1643 CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1644 END SELECT 1591 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1645 1592 ENDIF 1646 1593 ENDIF … … 1672 1619 IF( iom_file(kiomid)%nfid > 0 ) THEN 1673 1620 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1674 SELECT CASE (iom_file(kiomid)%iolib) 1675 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1676 CASE DEFAULT 1677 CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1678 END SELECT 1621 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1679 1622 ENDIF 1680 1623 ENDIF … … 1706 1649 IF( iom_file(kiomid)%nfid > 0 ) THEN 1707 1650 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1708 SELECT CASE (iom_file(kiomid)%iolib) 1709 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1710 CASE DEFAULT 1711 CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1712 END SELECT 1651 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1713 1652 ENDIF 1714 1653 ENDIF … … 1716 1655 END SUBROUTINE iom_rp3d 1717 1656 1657 1658 SUBROUTINE iom_delay_rst( cdaction, cdcpnt, kncid ) 1659 !!--------------------------------------------------------------------- 1660 !! Routine iom_delay_rst: used read/write restart related to mpp_delay 1661 !! 1662 !!--------------------------------------------------------------------- 1663 CHARACTER(len=*), INTENT(in ) :: cdaction ! 1664 CHARACTER(len=*), INTENT(in ) :: cdcpnt 1665 INTEGER , INTENT(in ) :: kncid 1666 ! 1667 INTEGER :: ji 1668 INTEGER :: indim 1669 LOGICAL :: llattexist 1670 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zreal1d 1671 !!--------------------------------------------------------------------- 1672 ! 1673 ! =================================== 1674 IF( TRIM(cdaction) == 'READ' ) THEN ! read restart related to mpp_delay ! 1675 ! =================================== 1676 DO ji = 1, nbdelay 1677 IF ( c_delaycpnt(ji) == cdcpnt ) THEN 1678 CALL iom_chkatt( kncid, 'DELAY_'//c_delaylist(ji), llattexist, indim ) 1679 IF( llattexist ) THEN 1680 ALLOCATE( todelay(ji)%z1d(indim) ) 1681 CALL iom_getatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) ) 1682 ndelayid(ji) = 0 ! set to 0 to specify that the value was read in the restart 1683 ENDIF 1684 ENDIF 1685 END DO 1686 ! ==================================== 1687 ELSE ! write restart related to mpp_delay ! 1688 ! ==================================== 1689 DO ji = 1, nbdelay ! save only ocean delayed global communication variables 1690 IF ( c_delaycpnt(ji) == cdcpnt ) THEN 1691 IF( ASSOCIATED(todelay(ji)%z1d) ) THEN 1692 CALL mpp_delay_rcv(ji) ! make sure %z1d is received 1693 CALL iom_putatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) ) 1694 ENDIF 1695 ENDIF 1696 END DO 1697 ! 1698 ENDIF 1699 1700 END SUBROUTINE iom_delay_rst 1701 1702 1718 1703 1719 1704 !!---------------------------------------------------------------------- … … 1971 1956 SELECT CASE ( cdgrd ) 1972 1957 CASE('T') ; zmask(:,:,:) = tmask(:,:,:) 1973 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( zmask, 'U', 1. )1974 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( zmask, 'V', 1. )1958 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( 'iom', zmask, 'U', 1. ) 1959 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( 'iom', zmask, 'V', 1. ) 1975 1960 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 1976 1961 END SELECT … … 2015 2000 ! 2016 2001 z_fld(:,:) = 1._wp 2017 CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold2002 CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. ) ! Working array for location of northfold 2018 2003 ! 2019 2004 ! Cell vertices that can be defined … … 2033 2018 ! Cell vertices on boundries 2034 2019 DO jn = 1, 4 2035 CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp )2036 CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp )2020 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 2021 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 2037 2022 END DO 2038 2023 !
Note: See TracChangeset
for help on using the changeset viewer.
