1146
1147
1149
1150
1151
1152 integer, intent(in) :: ng, tile, model
1153 integer, intent(in) :: InpStrRec, InpEndRec
1154 integer, intent(in) :: LBi, UBi, LBj, UBj
1155
1156 integer, intent(inout) :: OutStrRec
1157
1158 character (len=*) :: InpName, OutName
1159
1160
1161
1162 integer :: InpRec, OutRec, Tindex
1163 integer :: i, ic, itrc, status
1164
1165 integer :: Vsize(4)
1166
1167 real(r8) :: Fmin, Fmax
1168 real(dp) :: Fscl, stime
1169
1170 character (len=15) :: Tstring
1171 character (len=22) :: t_code
1172
1173 character (len=*), parameter :: MyFile = &
1174 & __FILE__//", state_join_pio"
1175
1176 TYPE (IO_Desc_t), pointer :: ioDesc
1177 TYPE (My_VarDesc), pointer :: pioVar
1178
1179 TYPE (File_desc_t) :: pioFileInp, pioFileOut
1180
1181 sourcefile=myfile
1182
1183
1184
1185
1186
1187
1188
1190 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1191 WRITE (stdout,10) trim(inpname)
1192 RETURN
1193 END IF
1194
1195
1196
1198 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1199 WRITE (stdout,10) trim(inpname)
1200 RETURN
1201 END IF
1202
1203
1204
1206 & piofile = piofileinp)
1207 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1208
1209
1210
1211
1212 DO i=1,4
1213 vsize(i)=0
1214 END DO
1215
1216
1217
1218 outrec=outstrrec-1
1219 tindex=1
1220 fscl=1.0_dp
1221
1222 rec_loop : DO inprec=inpstrrec,inpendrec
1223 outrec=outrec+1
1224 var_loop : DO i=1,n_var
1225
1226
1227
1228 check1 : IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1230 & trim(var_name(i)), &
1231 & rclock%DateNumber, stime, &
1232 & piofile = piofileinp, &
1233 & start = (/inprec/), &
1234 & total = (/1/))
1235 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1236 IF (master) THEN
1237 WRITE (stdout,30) trim(vname(1,idtime)), inprec, &
1238 & trim(inpname)
1239 END IF
1240 exit_flag=2
1241 RETURN
1242 END IF
1243
1245 & trim(var_name(i)), stime, &
1246 & (/outrec/), (/1/), &
1247 & piofile = piofileout, &
1249 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1250 IF (master) THEN
1251 WRITE (stdout,40) trim(vname(1,idtime)), outrec, &
1252 & trim(outname)
1253 END IF
1254 exit_flag=3
1255 RETURN
1256 ELSE
1257 CALL time_string (stime, t_code)
1258 WRITE (tstring,'(f15.4)') stime*sec2day
1259 IF (master) THEN
1260 WRITE (stdout,20) t_code, &
1261 & ng, trim(adjustl(tstring)), inprec, &
1262 & tindex, trim(inpname), &
1263 & ng, trim(adjustl(tstring)), outrec, &
1264 & tindex, trim(outname)
1265 END IF
1266 END IF
1267
1268
1269
1270 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
1271
1273 IF (kind(ocean(ng)%zeta).eq.8) THEN
1274 piovar%dkind=pio_double
1276 ELSE
1277 piovar%dkind=pio_real
1279 END IF
1280 piovar%gtype=r2dvar
1281
1282 status=nf_fread2d(ng, model, inpname, piofileinp, &
1283 & var_name(i), piovar, &
1284 & inprec, iodesc, vsize, &
1285 & lbi, ubi, lbj, ubj, &
1286 & fscl, fmin, fmax, &
1287# ifdef MASKING
1288 & grid(ng) % rmask, &
1289# endif
1290 & ocean(ng) % zeta(:,:,tindex))
1291 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1292 IF (master) THEN
1293 WRITE (stdout,30) trim(vname(1,idfsur)), inprec, &
1294 & trim(inpname)
1295 END IF
1296 exit_flag=2
1297 ioerror=status
1298 RETURN
1299 END IF
1300
1301 IF (var_type(i).eq.pio_double) THEN
1302 piovar%dkind=pio_double
1304 ELSE
1305 piovar%dkind=pio_real
1307 END IF
1308
1309 status=nf_fwrite2d(ng, model, piofileout, idfsur, &
1310 & piovar, outrec, iodesc, &
1311 & lbi, ubi, lbj, ubj, fscl, &
1312# ifdef MASKING
1313 & grid(ng) % rmask, &
1314# endif
1315 & ocean(ng) % zeta(:,:,tindex), &
1316 & setfillval = .false.)
1317 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1318 IF (master) THEN
1319 WRITE (stdout,40) trim(vname(1,idfsur)), outrec, &
1320 & trim(outname)
1321 END IF
1322 exit_flag=3
1323 ioerror=status
1324 RETURN
1325 ELSE
1326 IF (master) THEN
1327 WRITE (stdout,50) trim(vname(2,idfsur)), fmin, fmax
1328 END IF
1329 END IF
1330
1331# ifdef FORWARD_RHS
1332
1333
1334
1335 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrzet))) THEN
1336
1338 IF (kind(ocean(ng)%rzeta).eq.8) THEN
1339 piovar%dkind=pio_double
1341 ELSE
1342 piovar%dkind=pio_real
1344 END IF
1345 piovar%gtype=r2dvar
1346
1347 status=nf_fread2d(ng, model, inpname, piofileinp, &
1348 & var_name(i), piovar, &
1349 & inprec, iodesc, vsize, &
1350 & lbi, ubi, lbj, ubj, &
1351 & fscl, fmin, fmax, &
1352# ifdef MASKING
1353 & grid(ng) % rmask, &
1354# endif
1355 & ocean(ng) % rzeta(:,:,tindex))
1356 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1357 IF (master) THEN
1358 WRITE (stdout,30) trim(vname(1,idrzet)), inprec, &
1359 & trim(inpname)
1360 END IF
1361 exit_flag=2
1362 ioerror=status
1363 RETURN
1364 END IF
1365
1366 IF (var_type(i).eq.pio_double) THEN
1367 piovar%dkind=pio_double
1369 ELSE
1370 piovar%dkind=pio_real
1372 END IF
1373
1374 status=nf_fwrite2d(ng, model, piofileout, idrzet, &
1375 & piovar, outrec, iodesc, &
1376 & lbi, ubi, lbj, ubj, fscl, &
1377# ifdef MASKING
1378 & grid(ng) % rmask, &
1379# endif
1380 & ocean(ng) % rzeta(:,:,tindex))
1381 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1382 IF (master) THEN
1383 WRITE (stdout,40) trim(vname(1,idrzet)), outrec, &
1384 & trim(outname)
1385 END IF
1386 exit_flag=3
1387 ioerror=status
1388 RETURN
1389 ELSE
1390 IF (master) THEN
1391 WRITE (stdout,50) trim(vname(2,idrzet)), fmin, fmax
1392 END IF
1393 END IF
1394# endif
1395
1396
1397
1398 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
1399
1401 IF (kind(ocean(ng)%ubar).eq.8) THEN
1402 piovar%dkind=pio_double
1404 ELSE
1405 piovar%dkind=pio_real
1407 END IF
1408 piovar%gtype=u2dvar
1409
1410 status=nf_fread2d(ng, model, inpname, piofileinp, &
1411 & var_name(i), piovar, &
1412 & inprec, iodesc, vsize, &
1413 & lbi, ubi, lbj, ubj, &
1414 & fscl, fmin, fmax, &
1415# ifdef MASKING
1416 & grid(ng) % umask_full, &
1417# endif
1418 & ocean(ng) % ubar(:,:,tindex))
1419 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1420 IF (master) THEN
1421 WRITE (stdout,30) trim(vname(1,idubar)), inprec, &
1422 & trim(inpname)
1423 END IF
1424 exit_flag=2
1425 ioerror=status
1426 RETURN
1427 END IF
1428
1429 IF (var_type(i).eq.pio_double) THEN
1430 piovar%dkind=pio_double
1432 ELSE
1433 piovar%dkind=pio_real
1435 END IF
1436
1437 status=nf_fwrite2d(ng, model, piofileout, idubar, &
1438 & piovar, outrec, iodesc, &
1439 & lbi, ubi, lbj, ubj, fscl, &
1440# ifdef MASKING
1441 & grid(ng) % umask_full, &
1442# endif
1443 & ocean(ng) % ubar(:,:,tindex))
1444 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1445 IF (master) THEN
1446 WRITE (stdout,40) trim(vname(1,idubar)), outrec, &
1447 & trim(outname)
1448 END IF
1449 exit_flag=3
1450 ioerror=status
1451 RETURN
1452 ELSE
1453 IF (master) THEN
1454 WRITE (stdout,50) trim(vname(2,idubar)), fmin, fmax
1455 END IF
1456 END IF
1457
1458# ifdef FORWARD_RHS
1459
1460
1461
1462 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idru2d))) THEN
1463
1465 IF (kind(ocean(ng)%rubar).eq.8) THEN
1466 piovar%dkind=pio_double
1468 ELSE
1469 piovar%dkind=pio_real
1471 END IF
1472 piovar%gtype=u2dvar
1473
1474 status=nf_fread2d(ng, model, inpname, piofileinp, &
1475 & var_name(i), piovar, &
1476 & inprec, iodesc, vsize, &
1477 & lbi, ubi, lbj, ubj, &
1478 & fscl, fmin, fmax, &
1479# ifdef MASKING
1480 & grid(ng) % umask_full, &
1481# endif
1482 & ocean(ng) % rubar(:,:,tindex))
1483 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1484 IF (master) THEN
1485 WRITE (stdout,30) trim(vname(1,idru2d)), inprec, &
1486 & trim(inpname)
1487 END IF
1488 exit_flag=2
1489 ioerror=status
1490 RETURN
1491 END IF
1492
1493 IF (var_type(i).eq.pio_double) THEN
1494 piovar%dkind=pio_double
1496 ELSE
1497 piovar%dkind=pio_real
1499 END IF
1500
1501 status=nf_fwrite2d(ng, model, piofileout, idru2d, &
1502 & piovar, outrec, iodesc, &
1503 & lbi, ubi, lbj, ubj, fscl, &
1504# ifdef MASKING
1505 & grid(ng) % umask_full, &
1506# endif
1507 & ocean(ng) % rubar(:,:,tindex))
1508 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1509 IF (master) THEN
1510 WRITE (stdout,40) trim(vname(1,idru2d)), outrec, &
1511 & trim(outname)
1512 END IF
1513 exit_flag=3
1514 ioerror=status
1515 RETURN
1516 ELSE
1517 IF (master) THEN
1518 WRITE (stdout,50) trim(vname(2,idru2d)), fmin, fmax
1519 END IF
1520 END IF
1521# endif
1522
1523
1524
1525 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
1526
1528 IF (kind(ocean(ng)%vbar).eq.8) THEN
1529 piovar%dkind=pio_double
1531 ELSE
1532 piovar%dkind=pio_real
1534 END IF
1535 piovar%gtype=v2dvar
1536
1537 status=nf_fread2d(ng, model, inpname, piofileinp, &
1538 & var_name(i), piovar, &
1539 & inprec, iodesc, vsize, &
1540 & lbi, ubi, lbj, ubj, &
1541 & fscl, fmin, fmax, &
1542# ifdef MASKING
1543 & grid(ng) % vmask_full, &
1544# endif
1545 & ocean(ng) % vbar(:,:,tindex))
1546 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1547 IF (master) THEN
1548 WRITE (stdout,30) trim(vname(1,idvbar)), inprec, &
1549 & trim(inpname)
1550 END IF
1551 exit_flag=2
1552 ioerror=status
1553 RETURN
1554 END IF
1555
1556 IF (var_type(i).eq.pio_double) THEN
1557 piovar%dkind=pio_double
1559 ELSE
1560 piovar%dkind=pio_real
1562 END IF
1563
1564 status=nf_fwrite2d(ng, model, piofileout, idvbar, &
1565 & piovar, outrec, iodesc, &
1566 & lbi, ubi, lbj, ubj, fscl, &
1567# ifdef MASKING
1568 & grid(ng) % vmask_full, &
1569# endif
1570 & ocean(ng) % vbar(:,:,tindex))
1571 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1572 IF (master) THEN
1573 WRITE (stdout,40) trim(vname(1,idvbar)), outrec, &
1574 & trim(outname)
1575 END IF
1576 exit_flag=3
1577 ioerror=status
1578 RETURN
1579 ELSE
1580 IF (master) THEN
1581 WRITE (stdout,50) trim(vname(2,idvbar)), fmin, fmax
1582 END IF
1583 END IF
1584
1585# ifdef FORWARD_RHS
1586
1587
1588
1589 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrv2d))) THEN
1590
1592 IF (kind(ocean(ng)%rvbar).eq.8) THEN
1593 piovar%dkind=pio_double
1595 ELSE
1596 piovar%dkind=pio_real
1598 END IF
1599 piovar%gtype=v2dvar
1600
1601 status=nf_fread2d(ng, model, inpname, piofileinp, &
1602 & var_name(i), piovar, &
1603 & inprec, iodesc, vsize, &
1604 & lbi, ubi, lbj, ubj, &
1605 & fscl, fmin, fmax, &
1606# ifdef MASKING
1607 & grid(ng) % vmask_full, &
1608# endif
1609 & ocean(ng) % rvbar(:,:,tindex))
1610 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1611 IF (master) THEN
1612 WRITE (stdout,30) trim(vname(1,idrv2d)), inprec, &
1613 & trim(inpname)
1614 END IF
1615 exit_flag=2
1616 ioerror=status
1617 RETURN
1618 END IF
1619
1620 IF (var_type(i).eq.pio_double) THEN
1621 piovar%dkind=pio_double
1623 ELSE
1624 piovar%dkind=pio_real
1626 END IF
1627
1628 status=nf_fwrite2d(ng, model, piofileout, idrv2d &
1629 & piovar, outrec, iodesc, &
1630 & lbi, ubi, lbj, ubj, fscl, &
1631# ifdef MASKING
1632 & grid(ng) % vmask_full, &
1633# endif
1634 & ocean(ng) % rvbar(:,:,tindex))
1635 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1636 IF (master) THEN
1637 WRITE (stdout,40) trim(vname(1,idrv2d)), outrec, &
1638 & trim(outname)
1639 END IF
1640 exit_flag=3
1641 ioerror=status
1642 RETURN
1643 ELSE
1644 IF (master) THEN
1645 WRITE (stdout,50) trim(vname(2,idrv2d)), fmin, fmax
1646 END IF
1647 END IF
1648# endif
1649# ifdef SOLVE3D
1650# ifdef FORWARD_RHS
1651
1652
1653
1654 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idruct))) THEN
1655
1657 IF (kind(ocean(ng)%rufrc).eq.8) THEN
1658 piovar%dkind=pio_double
1660 ELSE
1661 piovar%dkind=pio_real
1663 END IF
1664 piovar%gtype=u2dvar
1665
1666 status=nf_fread2d(ng, model, inpname, piofileinp, &
1667 & var_name(i), piovar, &
1668 & inprec, iodesc, vsize, &
1669 & lbi, ubi, lbj, ubj, &
1670 & fscl, fmin, fmax, &
1671# ifdef MASKING
1672 & grid(ng) % umask_full, &
1673# endif
1674 & ocean(ng) % rufrc)
1675 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1676 IF (master) THEN
1677 WRITE (stdout,30) trim(vname(1,idruct)), inprec, &
1678 & trim(inpname)
1679 END IF
1680 exit_flag=2
1681 ioerror=status
1682 RETURN
1683 END IF
1684
1685 IF (var_type(i).eq.pio_double) THEN
1686 piovar%dkind=pio_double
1688 ELSE
1689 piovar%dkind=pio_real
1691 END IF
1692
1693 status=nf_fwrite2d(ng, model, piofileout, idruct, &
1694 & piovar, outrec, iodesc, &
1695 & lbi, ubi, lbj, ubj, fscl, &
1696# ifdef MASKING
1697 & grid(ng) % umask_full, &
1698# endif
1699 & ocean(ng) % rufrc)
1700 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1701 IF (master) THEN
1702 WRITE (stdout,40) trim(vname(1,idruct)), outrec, &
1703 & trim(outname)
1704 END IF
1705 exit_flag=3
1706 ioerror=status
1707 RETURN
1708 ELSE
1709 IF (master) THEN
1710 WRITE (stdout,50) trim(vname(2,idruct)), fmin, fmax
1711 END IF
1712 END IF
1713# endif
1714
1715
1716
1717 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idufx1))) THEN
1718
1720 IF (kind(coupling(ng)%DU_avg1).eq.8) THEN
1721 piovar%dkind=pio_double
1723 ELSE
1724 piovar%dkind=pio_real
1726 END IF
1727 piovar%gtype=u2dvar
1728
1729 status=nf_fread2d(ng, model, inpname, piofileinp, &
1730 & var_name(i), piovar, &
1731 & inprec, iodesc, vsize, &
1732 & lbi, ubi, lbj, ubj, &
1733 & fscl, fmin, fmax, &
1734# ifdef MASKING
1735 & grid(ng) % umask, &
1736# endif
1737 & coupling(ng) % DU_avg1)
1738 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1739 IF (master) THEN
1740 WRITE (stdout,30) trim(vname(1,idufx1)), inprec, &
1741 & trim(inpname)
1742 END IF
1743 exit_flag=2
1744 ioerror=status
1745 RETURN
1746 END IF
1747
1748 IF (var_type(i).eq.pio_double) THEN
1749 piovar%dkind=pio_double
1751 ELSE
1752 piovar%dkind=pio_real
1754 END IF
1755
1756 status=nf_fwrite2d(ng, model, piofileout, idufx1, &
1757 & piovar, outrec, iodesc, &
1758 & lbi, ubi, lbj, ubj, fscl, &
1759# ifdef MASKING
1760 & grid(ng) % umask, &
1761# endif
1762 & coupling(ng) % DU_avg1)
1763 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1764 IF (master) THEN
1765 WRITE (stdout,40) trim(vname(1,idufx1)), outrec, &
1766 & trim(outname)
1767 END IF
1768 exit_flag=3
1769 ioerror=status
1770 RETURN
1771 ELSE
1772 IF (master) THEN
1773 WRITE (stdout,50) trim(vname(2,idufx1)), fmin, fmax
1774 END IF
1775 END IF
1776
1777
1778
1779 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idufx2))) THEN
1780
1782 IF (kind(coupling(ng)%DU_avg2).eq.8) THEN
1783 piovar%dkind=pio_double
1785 ELSE
1786 piovar%dkind=pio_real
1788 END IF
1789 piovar%gtype=u2dvar
1790
1791 status=nf_fread2d(ng, model, inpname, piofileinp, &
1792 & var_name(i), piovar, &
1793 & inprec, iodesc, vsize, &
1794 & lbi, ubi, lbj, ubj, &
1795 & fscl, fmin, fmax, &
1796# ifdef MASKING
1797 & grid(ng) % umask, &
1798# endif
1799 & coupling(ng) % DU_avg2)
1800 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1801 IF (master) THEN
1802 WRITE (stdout,30) trim(vname(1,idufx2)), inprec, &
1803 & trim(inpname)
1804 END IF
1805 exit_flag=2
1806 ioerror=status
1807 RETURN
1808 END IF
1809
1810 IF (var_type(i).eq.pio_double) THEN
1811 piovar%dkind=pio_double
1813 ELSE
1814 piovar%dkind=pio_real
1816 END IF
1817
1818 status=nf_fwrite2d(ng, model, piofileout, idufx2, &
1819 & piovar, outrec, iodesc, &
1820 & lbi, ubi, lbj, ubj, fscl, &
1821# ifdef MASKING
1822 & grid(ng) % umask, &
1823# endif
1824 & coupling(ng) % DU_avg2)
1825 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1826 IF (master) THEN
1827 WRITE (stdout,40) trim(vname(1,idufx2)), outrec, &
1828 & trim(outname)
1829 END IF
1830 exit_flag=3
1831 ioerror=status
1832 RETURN
1833 ELSE
1834 IF (master) THEN
1835 WRITE (stdout,50) trim(vname(2,idufx2)), fmin, fmax
1836 END IF
1837 END IF
1838
1839# ifdef FORWARD_RHS
1840
1841
1842
1843 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrvct))) THEN
1844
1846 IF (kind(ocean(ng)%rvfrc).eq.8) THEN
1847 piovar%dkind=pio_double
1849 ELSE
1850 piovar%dkind=pio_real
1852 END IF
1853 piovar%gtype=v2dvar
1854
1855 status=nf_fread2d(ng, model, inpname, piofileinp, &
1856 & var_name(i), piovar, &
1857 & inprec, iodesc, vsize, &
1858 & lbi, ubi, lbj, ubj, &
1859 & fscl, fmin, fmax, &
1860# ifdef MASKING
1861 & grid(ng) % vmask_full, &
1862# endif
1863 & ocean(ng) % rvfrc)
1864 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1865 IF (master) THEN
1866 WRITE (stdout,30) trim(vname(1,idrvct)), inprec, &
1867 & trim(inpname)
1868 END IF
1869 exit_flag=2
1870 ioerror=status
1871 RETURN
1872 END IF
1873
1874 IF (var_type(i).eq.pio_double) THEN
1875 piovar%dkind=pio_double
1877 ELSE
1878 piovar%dkind=pio_real
1880 END IF
1881
1882 status=nf_fwrite2d(ng, model, piofileout, idrvct, &
1883 & piovar, outrec, iodesc, &
1884 & lbi, ubi, lbj, ubj, fscl, &
1885# ifdef MASKING
1886 & grid(ng) % vmask_full, &
1887# endif
1888 & ocean(ng) % rvfrc)
1889 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1890 IF (master) THEN
1891 WRITE (stdout,40) trim(vname(1,idrvct)), outrec, &
1892 & trim(outname)
1893 END IF
1894 exit_flag=3
1895 ioerror=status
1896 RETURN
1897 ELSE
1898 IF (master) THEN
1899 WRITE (stdout,50) trim(vname(2,idrvct)), fmin, fmax
1900 END IF
1901 END IF
1902# endif
1903
1904
1905
1906 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvfx1))) THEN
1907
1909 IF (kind(coupling(ng)%DV_avg1).eq.8) THEN
1910 piovar%dkind=pio_double
1912 ELSE
1913 piovar%dkind=pio_real
1915 END IF
1916 piovar%gtype=v2dvar
1917
1918 status=nf_fread2d(ng, model, inpname, piofileinp, &
1919 & var_name(i), piovar, &
1920 & inprec, iodesc, vsize, &
1921 & lbi, ubi, lbj, ubj, &
1922 & fscl, fmin, fmax, &
1923# ifdef MASKING
1924 & grid(ng) % vmask_full, &
1925# endif
1926 & coupling(ng) % DV_avg1)
1927 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1928 IF (master) THEN
1929 WRITE (stdout,30) trim(vname(1,idvfx1)), inprec, &
1930 & trim(inpname)
1931 END IF
1932 exit_flag=2
1933 ioerror=status
1934 RETURN
1935 END IF
1936
1937 IF (var_type(i).eq.pio_double) THEN
1938 piovar%dkind=pio_double
1940 ELSE
1941 piovar%dkind=pio_real
1943 END IF
1944
1945 status=nf_fwrite2d(ng, model, piofileout, idvfx1, &
1946 & piovar, outrec, iodesc, &
1947 & lbi, ubi, lbj, ubj, fscl, &
1948# ifdef MASKING
1949 & grid(ng) % vmask_full, &
1950# endif
1951 & coupling(ng) % DV_avg1)
1952 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1953 IF (master) THEN
1954 WRITE (stdout,40) trim(vname(1,idvfx1)), outrec, &
1955 & trim(outname)
1956 END IF
1957 exit_flag=3
1958 ioerror=status
1959 RETURN
1960 ELSE
1961 IF (master) THEN
1962 WRITE (stdout,50) trim(vname(2,idvfx1)), fmin, fmax
1963 END IF
1964 END IF
1965
1966
1967
1968 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvfx2))) THEN
1969
1971 IF (kind(coupling(ng)%DV_avg2).eq.8) THEN
1972 piovar%dkind=pio_double
1974 ELSE
1975 piovar%dkind=pio_real
1977 END IF
1978 piovar%gtype=v2dvar
1979
1980 status=nf_fread2d(ng, model, inpname, piofileinp, &
1981 & var_name(i), piovar, &
1982 & inprec, iodesc, vsize, &
1983 & lbi, ubi, lbj, ubj, &
1984 & fscl, fmin, fmax, &
1985# ifdef MASKING
1986 & grid(ng) % vmask_full, &
1987# endif
1988 & coupling(ng) % DV_avg2)
1989 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1990 IF (master) THEN
1991 WRITE (stdout,30) trim(vname(1,idvfx2)), inprec, &
1992 & trim(inpname)
1993 END IF
1994 exit_flag=2
1995 ioerror=status
1996 RETURN
1997 END IF
1998
1999 IF (var_type(i).eq.pio_double) THEN
2000 piovar%dkind=pio_double
2002 ELSE
2003 piovar%dkind=pio_real
2005 END IF
2006
2007 status=nf_fwrite2d(ng, model, piofileout, idvfx2, &
2008 & piovar, outrec, iodesc, &
2009 & lbi, ubi, lbj, ubj, fscl, &
2010# ifdef MASKING
2011 & grid(ng) % vmask_full, &
2012# endif
2013 & coupling(ng) % DV_avg2)
2014 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2015 IF (master) THEN
2016 WRITE (stdout,40) trim(vname(1,idvfx2)), outrec, &
2017 & trim(outname)
2018 END IF
2019 exit_flag=3
2020 ioerror=status
2021 RETURN
2022 ELSE
2023 IF (master) THEN
2024 WRITE (stdout,50) trim(vname(2,idvfx2)), fmin, fmax
2025 END IF
2026 END IF
2027
2028
2029
2030 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
2031
2033 IF (kind(ocean(ng)%u).eq.8) THEN
2034 piovar%dkind=pio_double
2036 ELSE
2037 piovar%dkind=pio_real
2039 END IF
2040 piovar%gtype=u3dvar
2041
2042 status=nf_fread3d(ng, model, inpname, piofileinp, &
2043 & var_name(i), piovar, &
2044 & inprec, iodesc, vsize, &
2045 & lbi, ubi, lbj, ubj, 1, n(ng), &
2046 & fscl, fmin, fmax, &
2047# ifdef MASKING
2048 & grid(ng) % umask_full, &
2049# endif
2050 & ocean(ng) % u(:,:,:,tindex))
2051 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2052 IF (master) THEN
2053 WRITE (stdout,30) trim(vname(1,iduvel)), inprec, &
2054 & trim(inpname)
2055 END IF
2056 exit_flag=2
2057 ioerror=status
2058 RETURN
2059 END IF
2060
2061 IF (var_type(i).eq.pio_double) THEN
2062 piovar%dkind=pio_double
2064 ELSE
2065 piovar%dkind=pio_real
2067 END IF
2068
2069 status=nf_fwrite3d(ng, model, piofileout, iduvel, &
2070 & piovar, outrec, iodesc, &
2071 & lbi, ubi, lbj, ubj, 1, n(ng), fscl, &
2072# ifdef MASKING
2073 & grid(ng) % umask_full, &
2074# endif
2075 & ocean(ng) % u(:,:,:,tindex))
2076 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2077 IF (master) THEN
2078 WRITE (stdout,40) trim(vname(1,iduvel)), outrec, &
2079 & trim(outname)
2080 END IF
2081 exit_flag=3
2082 ioerror=status
2083 RETURN
2084 ELSE
2085 IF (master) THEN
2086 WRITE (stdout,50) trim(vname(2,iduvel)), fmin, fmax
2087 END IF
2088 END IF
2089
2090# ifdef FORWARD_RHS
2091
2092
2093
2094 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idru3d))) THEN
2095
2097 IF (kind(ocean(ng)%ru).eq.8) THEN
2098 piovar%dkind=pio_double
2100 ELSE
2101 piovar%dkind=pio_real
2103 END IF
2104 piovar%gtype=u3dvar
2105
2106 status=nf_fread3d(ng, model, inpname, piofileinp, &
2107 & var_name(i), piovar, &
2108 & inprec, iodesc, vsize, &
2109 & lbi, ubi, lbj, ubj, 1, n(ng), &
2110 & fscl, fmin, fmax, &
2111# ifdef MASKING
2112 & grid(ng) % umask_full, &
2113# endif
2114 & ocean(ng) % ru(:,:,:,tindex))
2115 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2116 IF (master) THEN
2117 WRITE (stdout,30) trim(vname(1,idru3d)), inprec, &
2118 & trim(inpname)
2119 END IF
2120 exit_flag=2
2121 ioerror=status
2122 RETURN
2123 END IF
2124
2125 IF (var_type(i).eq.pio_double) THEN
2126 piovar%dkind=pio_double
2128 ELSE
2129 piovar%dkind=pio_real
2131 END IF
2132
2133 status=nf_fwrite3d(ng, model, piofileout, idru3d, &
2134 & piovar, outrec, iodesc, &
2135 & lbi, ubi, lbj, ubj, 1, n(ng), fscl, &
2136# ifdef MASKING
2137 & grid(ng) % umask_full, &
2138# endif
2139 & ocean(ng) % ru(:,:,:,tindex))
2140 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2141 IF (master) THEN
2142 WRITE (stdout,40) trim(vname(1,idru3d)), outrec, &
2143 & trim(outname)
2144 END IF
2145 exit_flag=3
2146 ioerror=status
2147 RETURN
2148 ELSE
2149 IF (master) THEN
2150 WRITE (stdout,50) trim(vname(2,idru3d)), fmin, fmax
2151 END IF
2152 END IF
2153# endif
2154
2155
2156
2157 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
2158
2160 IF (kind(ocean(ng)%v).eq.8) THEN
2161 piovar%dkind=pio_double
2163 ELSE
2164 piovar%dkind=pio_real
2166 END IF
2167 piovar%gtype=v3dvar
2168
2169 status=nf_fread3d(ng, model, inpname, piofileinp, &
2170 & var_name(i), piovar, &
2171 & inprec, iodesc, vsize, &
2172 & lbi, ubi, lbj, ubj, 1, n(ng), &
2173 & fscl, fmin, fmax, &
2174# ifdef MASKING
2175 & grid(ng) % vmask_full, &
2176# endif
2177 & ocean(ng) % v(:,:,:,tindex))
2178 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2179 IF (master) THEN
2180 WRITE (stdout,30) trim(vname(1,idvvel)), inprec, &
2181 & trim(inpname)
2182 END IF
2183 exit_flag=2
2184 ioerror=status
2185 RETURN
2186 END IF
2187
2188 IF (var_type(i).eq.pio_double) THEN
2189 piovar%dkind=pio_double
2191 ELSE
2192 piovar%dkind=pio_real
2194 END IF
2195
2196 status=nf_fwrite3d(ng, model, piofileout, idvvel, &
2197 & piovar, outrec, iodesc, &
2198 & lbi, ubi, lbj, ubj, 1, n(ng), fscl, &
2199# ifdef MASKING
2200 & grid(ng) % vmask_full, &
2201# endif
2202 & ocean(ng) % v(:,:,:,tindex))
2203 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2204 IF (master) THEN
2205 WRITE (stdout,40) trim(vname(1,idvvel)), outrec, &
2206 & trim(outname)
2207 END IF
2208 exit_flag=3
2209 ioerror=status
2210 RETURN
2211 ELSE
2212 IF (master) THEN
2213 WRITE (stdout,50) trim(vname(2,idvvel)), fmin, fmax
2214 END IF
2215 END IF
2216
2217# ifdef FORWARD_RHS
2218
2219
2220
2221 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idrv3d))) THEN
2222
2224 IF (kind(ocean(ng)%rv).eq.8) THEN
2225 piovar%dkind=pio_double
2227 ELSE
2228 piovar%dkind=pio_real
2230 END IF
2231 piovar%gtype=v3dvar
2232
2233 status=nf_fread3d(ng, model, inpname, piofileinp, &
2234 & var_name(i), piovar, &
2235 & inprec, iodesc, vsize, &
2236 & lbi, ubi, lbj, ubj, 1, n(ng), &
2237 & fscl, fmin, fmax, &
2238# ifdef MASKING
2239 & grid(ng) % vmask_full, &
2240# endif
2241 & ocean(ng) % rv(:,:,:,tindex))
2242 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2243 IF (master) THEN
2244 WRITE (stdout,30) trim(vname(1,idrv3d)), inprec, &
2245 & trim(inpname)
2246 END IF
2247 exit_flag=2
2248 ioerror=status
2249 RETURN
2250 END IF
2251
2252 IF (var_type(i).eq.pio_double) THEN
2253 piovar%dkind=pio_double
2255 ELSE
2256 piovar%dkind=pio_real
2258 END IF
2259
2260 status=nf_fwrite3d(ng, model, piofileout, idrv3d, &
2261 & piovar, outrec, iodesc, &
2262 & lbi, ubi, lbj, ubj, 1, n(ng), fscl, &
2263# ifdef MASKING
2264 & grid(ng) % vmask_full, &
2265# endif
2266 & ocean(ng) % rv(:,:,:,tindex))
2267 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2268 IF (master) THEN
2269 WRITE (stdout,40) trim(vname(1,idrv3d)), outrec, &
2270 & trim(outname)
2271 END IF
2272 exit_flag=3
2273 ioerror=status
2274 RETURN
2275 ELSE
2276 IF (master) THEN
2277 WRITE (stdout,50) trim(vname(2,idrv3d)), fmin, fmax
2278 END IF
2279 END IF
2280# endif
2281# ifdef FORWARD_MIXING
2282
2283
2284
2285 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvis))) THEN
2286
2288 IF (kind(mixing(ng)%Akv).eq.8) THEN
2289 piovar%dkind=pio_double
2291 ELSE
2292 piovar%dkind=pio_real
2294 END IF
2295 piovar%gtype=w3dvar
2296
2297 status=nf_fread3d(ng, model, inpname, piofileinp, &
2298 & var_name(i), piovar, &
2299 & inprec, iodesc, vsize, &
2300 & lbi, ubi, lbj, ubj, 0, n(ng), &
2301 & fscl, fmin, fmax, &
2302# ifdef MASKING
2303 & grid(ng) % rmask, &
2304# endif
2305 & mixing(ng) % Akv)
2306 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2307 IF (master) THEN
2308 WRITE (stdout,30) trim(vname(1,idvvis)), inprec, &
2309 & trim(inpname)
2310 END IF
2311 exit_flag=2
2312 ioerror=status
2313 RETURN
2314 END IF
2315
2316 IF (var_type(i).eq.pio_double) THEN
2317 piovar%dkind=pio_double
2319 ELSE
2320 piovar%dkind=pio_real
2322 END IF
2323
2324 status=nf_fwrite3d(ng, model, piofileout, idvvis, &
2325 & piovar, outrec, iodesc, &
2326 & lbi, ubi, lbj, ubj, 0, n(ng), fscl, &
2327# ifdef MASKING
2328 & grid(ng) % rmask, &
2329# endif
2330 & mixing(ng) % Akv)
2331 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2332 IF (master) THEN
2333 WRITE (stdout,40) trim(vname(1,idvvis)), outrec, &
2334 & trim(outname)
2335 END IF
2336 exit_flag=3
2337 ioerror=status
2338 RETURN
2339 ELSE
2340 IF (master) THEN
2341 WRITE (stdout,50) trim(vname(2,idvvis)), fmin, fmax
2342 END IF
2343 END IF
2344# endif
2345# endif
2346 END IF check1
2347
2348# ifdef SOLVE3D
2349
2350
2351
2352 tracer1_loop : DO itrc=1,nt(ng)
2353
2354 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
2355
2357 IF (kind(ocean(ng)%t).eq.8) THEN
2358 piovar%dkind=pio_double
2360 ELSE
2361 piovar%dkind=pio_real
2363 END IF
2364 piovar%gtype=r3dvar
2365
2366 status=nf_fread3d(ng, model, inpname, piofileinp, &
2367 & var_name(i), piovar, &
2368 & inprec, iodesc, vsize, &
2369 & lbi, ubi, lbj, ubj, 1, n(ng), &
2370 & fscl, fmin, fmax, &
2371# ifdef MASKING
2372 & grid(ng) % rmask, &
2373# endif
2374 & ocean(ng) % t(:,:,:,tindex,itrc))
2375 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2376 IF (master) THEN
2377 WRITE (stdout,30) trim(vname(1,idtvar(itrc))), &
2378 & inprec, trim(inpname)
2379 END IF
2380 exit_flag=2
2381 ioerror=status
2382 RETURN
2383 END IF
2384
2385 IF (var_type(i).eq.pio_double) THEN
2386 piovar%dkind=pio_double
2388 ELSE
2389 piovar%dkind=pio_real
2391 END IF
2392
2393 status=nf_fwrite3d(ng, model, piofileout, idtvar(itrc), &
2394 & piovar, outrec, iodesc, &
2395 & lbi, ubi, lbj, ubj, 1, n(ng), fscl, &
2396# ifdef MASKING
2397 & grid(ng) % rmask, &
2398# endif
2399 & ocean(ng) % t(:,:,:,tindex,itrc))
2400 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2401 IF (master) THEN
2402 WRITE (stdout,40) trim(vname(1,idtvar(itrc))), &
2403 & outrec, trim(outname)
2404 END IF
2405 exit_flag=3
2406 ioerror=status
2407 RETURN
2408 ELSE
2409 IF (master) THEN
2410 WRITE (stdout,50) trim(vname(2,idtvar(itrc))), &
2411 & fmin, fmax
2412 END IF
2413 END IF
2414 END IF
2415 END DO tracer1_loop
2416
2417
2418
2419 tracer2_loop : DO itrc=1,nat
2422 piovar%gtype=w3dvar
2423
2424 IF (trim(var_name(i)).eq.trim(vname(1,iddiff(itrc)))) THEN
2425
2427 IF (kind(mixing(ng)%Akt).eq.8) THEN
2428 piovar%dkind=pio_double
2430 ELSE
2431 piovar%dkind=pio_real
2433 END IF
2434 piovar%gtype=w3dvar
2435
2436 status=nf_fread3d(ng, model, inpname, piofileinp, &
2437 & var_name(i), piovar, &
2438 & inprec, iodesc, vsize, &
2439 & lbi, ubi, lbj, ubj, 0, n(ng), &
2440 & fscl, fmin, fmax, &
2441# ifdef MASKING
2442 & grid(ng) % rmask, &
2443# endif
2444 & mixing(ng) % Akt(:,:,:,itrc))
2445 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2446 IF (master) THEN
2447 WRITE (stdout,30) trim(vname(1,iddiff(itrc))), &
2448 & inprec, trim(inpname)
2449 END IF
2450 exit_flag=2
2451 ioerror=status
2452 RETURN
2453 END IF
2454
2455 IF (var_type(i).eq.pio_double) THEN
2456 piovar%dkind=pio_double
2458 ELSE
2459 piovar%dkind=pio_real
2461 END IF
2462
2463 status=nf_fwrite3d(ng, model, piofileout, iddiff(itrc), &
2464 & piovar, outrec, iodesc, &
2465 & lbi, ubi, lbj, ubj, 0, n(ng), fscl, &
2466# ifdef MASKING
2467 & grid(ng) % rmask, &
2468# endif
2469 & mixing(ng) % Akt(:,:,:,itrc))
2470 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2471 IF (master) THEN
2472 WRITE (stdout,40) trim(vname(1,iddiff(itrc))), &
2473 & outrec, trim(outname)
2474 END IF
2475 exit_flag=3
2476 ioerror=status
2477 RETURN
2478 ELSE
2479 IF (master) THEN
2480 WRITE (stdout,50) trim(vname(2,iddiff(itrc))), &
2481 & fmin, fmax
2482 END IF
2483 END IF
2484 END IF
2485 END DO tracer2_loop
2486# endif
2487
2488 END DO var_loop
2489
2490 END DO rec_loop
2491
2492
2493
2494 outstrrec=outrec
2495
2496
2497
2499 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2500
2502 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2503
2504 10 FORMAT (/,' STATE_JOIN_PIO - unable to open grid NetCDF file:', &
2505 & 1x,a)
2506 20 FORMAT ('NLM: STATE_JOIN_PIO - Concatenating state fields,', &
2507 & t75,a,/,23x,'(Grid ',i2.2,', t = ',a,', InpRec=',i4.4, &
2508 & ', Index=',i1,', InpFile: ',a,')', &
2509 & /,19x,'(Grid ',i2.2,', t = ',a,', OutRec=',i4.4, &
2510 & ', Index=',i1,', OutFile: ',a,')')
2511 30 FORMAT (/,' STATE_JOIN_PIO - error while reading variable: ', &
2512 & a,2x,'at time record = ',i0, &
2513 & /,18x,'in input NetCDF file: ',a)
2514 40 FORMAT (/,' STATE_JOIN_PIO - error while writing variable: ', &
2515 & a,2x,'at time record = ',i0, &
2516 & /,18x,'in output NetCDF file: ',a)
2517 50 FORMAT (21x,'- ',a,/,23x,'(Min = ',1p,e15.8, &
2518 & ' Max = ',1p,e15.8,')')
2519
2520 RETURN
type(io_desc_t), dimension(:), pointer iodesc_sp_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dvar
integer, parameter pio_type
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dvar
type(var_desc_t), dimension(:), pointer var_desc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
subroutine, public pio_netcdf_close(ng, model, piofile, ncname, lupdate)
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar