970
971
973
974
975
976 integer, intent(in) :: ng
977
978 logical, intent(in) :: ldef
979
980
981
982 logical :: got_var(NV)
983
984 integer, parameter :: Natt = 25
985
986 integer :: i, ifield, itrc, ivar, j, nvd3, nvd4, nvd5
987 integer :: recdim, status
988# if defined WRITE_WATER && defined MASKING
989 integer :: xy_pdim, xyz_pdim
990# endif
991 integer :: DimIDs(nDimID)
992 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
993# if defined ECOSIM && defined DIAGNOSTICS_BIO
994 integer :: l3dgrd(4), l4dgrd(5)
995# endif
996
997# ifdef SOLVE3D
998# ifdef SEDIMENT
999 integer :: b3dgrd(4)
1000# endif
1001 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4), w3dgrd(4)
1002# endif
1003
1004 real(r8) :: Aval(6)
1005
1006 character (len= 13) :: Prefix
1007 character (len=256) :: ncname
1008 character (len=MaxLen) :: Vinfo(Natt)
1009
1010 character (len=*), parameter :: MyFile = &
1011 & __FILE__//", def_diags_pio"
1012
1013 sourcefile=myfile
1014
1015
1016
1017
1018
1019 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1020 ncname=dia(ng)%name
1021
1022 IF (master) THEN
1023 IF (ldef) THEN
1024 WRITE (stdout,10) ng, trim(ncname)
1025 ELSE
1026 WRITE (stdout,20) ng, trim(ncname)
1027 END IF
1028 END IF
1029
1030
1031
1032
1033
1034 define : IF (ldef) THEN
1036 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1037 IF (master) WRITE (stdout,30) trim(ncname)
1038 RETURN
1039 END IF
1040
1041
1042
1043
1044
1045 dimids=0
1046
1047 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xi_rho', &
1048 & iobounds(ng)%xi_rho, dimids( 1))
1049 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1050
1051 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xi_u', &
1052 & iobounds(ng)%xi_u, dimids( 2))
1053 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1054
1055 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xi_v', &
1056 & iobounds(ng)%xi_v, dimids( 3))
1057 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1058
1059 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xi_psi', &
1060 & iobounds(ng)%xi_psi, dimids( 4))
1061 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1062
1063 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'eta_rho', &
1064 & iobounds(ng)%eta_rho, dimids( 5))
1065 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1066
1067 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'eta_u', &
1068 & iobounds(ng)%eta_u, dimids( 6))
1069 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1070
1071 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'eta_v', &
1072 & iobounds(ng)%eta_v, dimids( 7))
1073 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1074
1075 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'eta_psi', &
1076 & iobounds(ng)%eta_psi, dimids( 8))
1077 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1078
1079# if defined WRITE_WATER && defined MASKING
1080 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xy_psi', &
1081 & iobounds(ng)%xy_psi, xy_pdim)
1082 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1083
1084 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xy_rho', &
1085 & iobounds(ng)%xy_rho, dimids(17))
1086 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1087
1088 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xy_u', &
1089 & iobounds(ng)%xy_u, dimids(18))
1090 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1091
1092 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xy_v', &
1093 & iobounds(ng)%xy_v, dimids(19))
1094 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1095# endif
1096
1097# ifdef SOLVE3D
1098# if defined WRITE_WATER && defined MASKING
1099 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xyz_psi', &
1100 & iobounds(ng)%xy_psi*n(ng), xyz_pdim)
1101 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1102
1103 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xyz_rho', &
1104 & iobounds(ng)%xy_rho*n(ng), dimids(20))
1105 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1106
1107 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xyz_u', &
1108 & iobounds(ng)%xy_u*n(ng), dimids(21))
1109 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1110
1111 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xyz_v', &
1112 & iobounds(ng)%xy_v*n(ng), dimids(22))
1113 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1114
1115 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xyz_w', &
1116 & iobounds(ng)%xy_rho*(n(ng)+1), dimids(23))
1117 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1118# endif
1119
1120 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 's_rho', &
1121 & n(ng), dimids( 9))
1122 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1123
1124 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 's_w', &
1125 & n(ng)+1, dimids(10))
1126 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1127
1128 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'tracer', &
1129 & nt(ng), dimids(11))
1130 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1131
1132# ifdef SEDIMENT
1133 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'NST', &
1134 & nst, dimids(32))
1135 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1136
1137 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'Nbed', &
1138 & nbed, dimids(16))
1139 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1140
1141# if defined WRITE_WATER && defined MASKING
1142 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'xybed', &
1143 & iobounds(ng)%xy_rho*nbed, dimids(24))
1144 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1145# endif
1146# endif
1147# ifdef ECOSIM
1148 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'Nbands', &
1149 & ndbands, dimids(33))
1150 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1151
1152 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'Nphy', &
1153 & nphy, dimids(25))
1154 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1155
1156 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'Nbac', &
1157 & nbac, dimids(26))
1158 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1159
1160 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'Ndom', &
1161 & ndom, dimids(27))
1162 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1163
1164 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'Nfec', &
1165 & nfec, dimids(28))
1166 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1167# endif
1168# endif
1169
1170 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'boundary', &
1171 & 4, dimids(14))
1172 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1173
1174# ifdef FOUR_DVAR
1175 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, 'Nstate', &
1176 & nstatevar(ng), dimids(29))
1177 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1178# endif
1179
1180 status=def_dim(ng, inlm, dia(ng)%pioFile, ncname, &
1181 & trim(adjustl(vname(5,idtime))), &
1182 & pio_unlimited, dimids(12))
1183 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1184
1185 recdim=dimids(12)
1186
1187
1188
1189# if defined WRITE_WATER && defined MASKING
1190 nvd3=2
1191 nvd4=2
1192 nvd5=2
1193# else
1194 nvd3=3
1195 nvd4=4
1196 nvd5=5
1197# endif
1198
1199
1200
1201# if defined WRITE_WATER && defined MASKING
1202 t2dgrd(1)=dimids(17)
1203 t2dgrd(2)=dimids(12)
1204# ifdef SOLVE3D
1205 t3dgrd(1)=dimids(20)
1206 t3dgrd(2)=dimids(12)
1207# endif
1208# else
1209 t2dgrd(1)=dimids( 1)
1210 t2dgrd(2)=dimids( 5)
1211 t2dgrd(3)=dimids(12)
1212# ifdef SOLVE3D
1213 t3dgrd(1)=dimids( 1)
1214 t3dgrd(2)=dimids( 5)
1215 t3dgrd(3)=dimids( 9)
1216 t3dgrd(4)=dimids(12)
1217# endif
1218# endif
1219
1220
1221
1222# if defined WRITE_WATER && defined MASKING
1223 u2dgrd(1)=dimids(18)
1224 u2dgrd(2)=dimids(12)
1225# ifdef SOLVE3D
1226 u3dgrd(1)=dimids(21)
1227 u3dgrd(2)=dimids(12)
1228# endif
1229# else
1230 u2dgrd(1)=dimids( 2)
1231 u2dgrd(2)=dimids( 6)
1232 u2dgrd(3)=dimids(12)
1233# ifdef SOLVE3D
1234 u3dgrd(1)=dimids( 2)
1235 u3dgrd(2)=dimids( 6)
1236 u3dgrd(3)=dimids( 9)
1237 u3dgrd(4)=dimids(12)
1238# endif
1239# endif
1240
1241
1242
1243# if defined WRITE_WATER && defined MASKING
1244 v2dgrd(1)=dimids(19)
1245 v2dgrd(2)=dimids(12)
1246# ifdef SOLVE3D
1247 v3dgrd(1)=dimids(22)
1248 v3dgrd(2)=dimids(12)
1249# endif
1250# else
1251 v2dgrd(1)=dimids( 3)
1252 v2dgrd(2)=dimids( 7)
1253 v2dgrd(3)=dimids(12)
1254# ifdef SOLVE3D
1255 v3dgrd(1)=dimids( 3)
1256 v3dgrd(2)=dimids( 7)
1257 v3dgrd(3)=dimids( 9)
1258 v3dgrd(4)=dimids(12)
1259# endif
1260# endif
1261# ifdef SOLVE3D
1262
1263
1264
1265# if defined WRITE_WATER && defined MASKING
1266 w3dgrd(1)=dimids(23)
1267 w3dgrd(2)=dimids(12)
1268# else
1269 w3dgrd(1)=dimids( 1)
1270 w3dgrd(2)=dimids( 5)
1271 w3dgrd(3)=dimids(10)
1272 w3dgrd(4)=dimids(12)
1273# endif
1274# ifdef SEDIMENT
1275
1276
1277
1278# if defined WRITE_WATER && defined MASKING
1279 b3dgrd(1)=dimids(24)
1280 b3dgrd(2)=dimids(12)
1281# else
1282 b3dgrd(1)=dimids( 1)
1283 b3dgrd(2)=dimids( 5)
1284 b3dgrd(3)=dimids(16)
1285 b3dgrd(4)=dimids(12)
1286# endif
1287# endif
1288# if defined ECOSIM && defined DIAGNOSTICS_BIO
1289
1290
1291
1292 l3dgrd(1)=dimids( 1)
1293 l3dgrd(2)=dimids( 5)
1294 l3dgrd(3)=dimids(33)
1295 l3dgrd(4)=dimids(12)
1296
1297 l4dgrd(1)=dimids( 1)
1298 l4dgrd(2)=dimids( 5)
1299 l4dgrd(3)=dimids( 9)
1300 l4dgrd(4)=dimids(33)
1301 l4dgrd(5)=dimids(12)
1302# endif
1303# endif
1304
1305
1306
1307 dia(ng)%Rindex=0
1308
1309
1310
1311 DO i=1,natt
1312 DO j=1,len(vinfo(1))
1313 vinfo(i)(j:j)=' '
1314 END DO
1315 END DO
1316 DO i=1,6
1317 aval(i)=0.0_r8
1318 END DO
1319
1320
1321
1322
1323 prefix=char(32)
1324
1325
1326
1327
1328
1329 CALL def_info (ng, inlm, dia(ng)%pioFile, ncname, dimids)
1330 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1331
1332
1333
1334
1335
1336
1337
1338 vinfo( 1)=vname(1,idtime)
1339 WRITE (vinfo( 2),'(a,a)') 'averaged ', trim(vname(2,idtime))
1340 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
1341 vinfo( 4)=trim(rclock%calendar)
1342 vinfo(14)=vname(4,idtime)
1343 vinfo(21)=vname(6,idtime)
1344 dia(ng)%pioVar(idtime)%dkind=
pio_tout
1345 dia(ng)%pioVar(idtime)%gtype=0
1346
1347 status=def_var(ng, inlm, dia(ng)%pioFile, &
1348 & dia(ng)%pioVar(idtime)%vd, &
1349 &
pio_tout, 1, (/recdim/), aval, vinfo, ncname, &
1350 & setparaccess = .true.)
1351 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1352
1353
1354
1355
1356 vinfo( 1)=vname(1,idfsur)
1357 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idfsur))
1358 vinfo( 3)=vname(3,idfsur)
1359 vinfo(14)=vname(4,idfsur)
1360 vinfo(16)=vname(1,idtime)
1361# if !defined WET_DRY && (defined WRITE_WATER && defined MASKING)
1362 vinfo(20)='mask_rho'
1363# endif
1364 vinfo(21)=vname(6,idfsur)
1365 vinfo(22)='coordinates'
1366 aval(5)=real(iinfo(1,idfsur,ng),r8)
1367 avg(ng)%pioVar(idfsur)%dkind=
pio_fout
1368 avg(ng)%pioVar(idfsur)%gtype=r2dvar
1369
1370 status=def_var(ng, inlm, dia(ng)%pioFile, &
1371 & dia(ng)%pioVar(idfsur)%vd, &
1372 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
1373 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1374
1375# ifdef DIAGNOSTICS_UV
1376
1377
1378
1379 DO ivar=1,ndm2d
1380 ifield=iddu2d(ivar)
1381 IF (dout(ifield,ng)) THEN
1382 vinfo( 1)=vname(1,ifield)
1383 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,ifield))
1384 vinfo( 3)=vname(3,ifield)
1385 vinfo(14)=vname(4,ifield)
1386 vinfo(16)=vname(1,idtime)
1387# if defined WRITE_WATER && defined MASKING
1388 vinfo(20)='mask_u'
1389# endif
1390 vinfo(21)=vname(6,ifield)
1391 vinfo(22)='coordinates'
1392 aval(5)=real(u2dvar,r8)
1393 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1394 dia(ng)%pioVar(ifield)%gtype=u2dvar
1395
1396 status=def_var(ng, inlm, dia(ng)%pioFile, &
1397 & dia(ng)%pioVar(ifield)%vd, &
1398 &
pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
1399 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1400 END IF
1401
1402 ifield=iddv2d(ivar)
1403 IF (dout(ifield,ng)) THEN
1404 vinfo( 1)=vname(1,ifield)
1405 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,ifield))
1406 vinfo( 3)=vname(3,ifield)
1407 vinfo(14)=vname(4,ifield)
1408 vinfo(16)=vname(1,idtime)
1409# if defined WRITE_WATER && defined MASKING
1410 vinfo(20)='mask_v'
1411# endif
1412 vinfo(21)=vname(6,ifield)
1413 vinfo(22)='coordinates'
1414 aval(5)=real(v2dvar,r8)
1415 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1416 dia(ng)%pioVar(ifield)%gtype=v2dvar
1417
1418 status=def_var(ng, inlm, dia(ng)%pioFile, &
1419 & dia(ng)%pioVar(ifield)%vd, &
1420 &
pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
1421 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1422 END IF
1423 END DO
1424
1425# ifdef SOLVE3D
1426
1427
1428
1429 DO ivar=1,ndm3d
1430 ifield=iddu3d(ivar)
1431 IF (dout(ifield,ng)) THEN
1432 vinfo( 1)=vname(1,ifield)
1433 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,ifield))
1434 vinfo( 3)=vname(3,ifield)
1435 vinfo(14)=vname(4,ifield)
1436 vinfo(16)=vname(1,idtime)
1437# if defined WRITE_WATER && defined MASKING
1438 vinfo(20)='mask_u'
1439# endif
1440 vinfo(21)=vname(6,ifield)
1441 vinfo(22)='coordinates'
1442 aval(5)=real(u3dvar,r8)
1443 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1444 dia(ng)%pioVar(ifield)%gtype=u3dvar
1445
1446 status=def_var(ng, inlm, dia(ng)%pioFile, &
1447 & dia(ng)%pioVar(ifield)%vd, &
1448 &
pio_fout, nvd4, u3dgrd, aval, vinfo, ncname)
1449 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1450 END IF
1451
1452 ifield=iddv3d(ivar)
1453 IF (dout(ifield,ng)) THEN
1454 vinfo( 1)=vname(1,ifield)
1455 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,ifield))
1456 vinfo( 3)=vname(3,ifield)
1457 vinfo(14)=vname(4,ifield)
1458 vinfo(16)=vname(1,idtime)
1459# if defined WRITE_WATER && defined MASKING
1460 vinfo(20)='mask_v'
1461# endif
1462 vinfo(21)=vname(6,ifield)
1463 vinfo(22)='coordinates'
1464 aval(5)=real(v3dvar,r8)
1465 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1466 dia(ng)%pioVar(ifield)%gtype=v3dvar
1467
1468 status=def_var(ng, inlm, dia(ng)%pioFile, &
1469 & dia(ng)%pioVar(ifield)%vd, &
1470 &
pio_fout, nvd4, v3dgrd, aval, vinfo, ncname)
1471 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1472 END IF
1473 END DO
1474# endif
1475# endif
1476# ifdef DIAGNOSTICS_TS
1477
1478
1479
1480 DO itrc=1,nt(ng)
1481 DO ivar=1,ndt
1482 ifield=iddtrc(itrc,ivar)
1483 IF (dout(ifield,ng)) THEN
1484 vinfo( 1)=vname(1,ifield)
1485 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,ifield))
1486 vinfo( 3)=vname(3,ifield)
1487 vinfo(14)=vname(4,ifield)
1488 vinfo(16)=vname(1,idtime)
1489# if defined WRITE_WATER && defined MASKING
1490 vinfo(20)='mask_rho'
1491# endif
1492 vinfo(21)=vname(6,ifield)
1493 vinfo(22)='coordinates'
1494 aval(5)=real(r3dvar,r8)
1495 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1496 dia(ng)%pioVar(ifield)%gtype=r3dvar
1497
1498 status=def_var(ng, inlm, dia(ng)%pioFile, &
1499 & dia(ng)%pioVar(ifield)%vd, &
1500 &
pio_fout, nvd4, t3dgrd, aval, vinfo, &
1501 & ncname)
1502 IF (founderror(exit_flag, noerror, &
1503 & __line__, myfile)) RETURN
1504 END IF
1505 END DO
1506 END DO
1507# endif
1508
1509# ifdef DIAGNOSTICS_BIO
1510# if defined BIO_FENNEL || defined HYPOXIA_SRM
1511
1512
1513
1514 DO ivar=1,ndbio2d
1515 ifield=idbio2(ivar)
1516 IF (dout(ifield,ng)) THEN
1517 vinfo( 1)=vname(1,ifield)
1518 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,ifield))
1519 vinfo( 3)=vname(3,ifield)
1520 vinfo(14)=vname(4,ifield)
1521 vinfo(16)=vname(1,idtime)
1522# if defined WRITE_WATER && defined MASKING
1523 vinfo(20)='mask_rho'
1524# endif
1525 vinfo(21)=vname(6,ifield)
1526 vinfo(22)='coordinates'
1527 aval(5)=real(r2dvar,r8)
1528 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1529 dia(ng)%pioVar(ifield)%gtype=r2dvar
1530
1531 status=def_var(ng, inlm, dia(ng)%pioFile, &
1532 & dia(ng)%pioVar(ifield)%vd, &
1533 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
1534 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1535 END IF
1536 END DO
1537# endif
1538# if defined BIO_FENNEL
1539
1540
1541
1542 DO ivar=1,ndbio3d
1543 ifield=idbio3(ivar)
1544 IF (dout(ifield,ng)) THEN
1545 vinfo( 1)=vname(1,ifield)
1546 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,ifield))
1547 vinfo( 3)=vname(3,ifield)
1548 vinfo(14)=vname(4,ifield)
1549 vinfo(16)=vname(1,idtime)
1550# if defined WRITE_WATER && defined MASKING
1551 vinfo(20)='mask_rho'
1552# endif
1553 vinfo(21)=vname(6,ifield)
1554 vinfo(22)='coordinates'
1555 aval(5)=real(r3dvar,r8)
1556 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1557 dia(ng)%pioVar(ifield)%gtype=r3dvar
1558
1559 status=def_var(ng, inlm, dia(ng)%pioFile, &
1560 & dia(ng)%pioVar(ifield)%vd, &
1561 &
pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
1562 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1563 END IF
1564 END DO
1565
1566# elif defined ECOSIM
1567
1568
1569
1570 DO ivar=1,ndbio3d
1571 ifield=idbio3(ivar)
1572 IF (dout(ifield,ng)) THEN
1573 vinfo( 1)=vname(1,ifield)
1574 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,ifield))
1575 vinfo( 3)=vname(3,ifield)
1576 vinfo(14)=vname(4,ifield)
1577 vinfo(16)=vname(1,idtime)
1578# if defined WRITE_WATER && defined MASKING
1579 vinfo(20)='mask_rho'
1580# endif
1581 vinfo(21)=vname(6,ifield)
1582 vinfo(22)='coordinates'
1583 aval(5)=real(iinfo(1,ifield,ng),r8)
1584 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1585 dia(ng)%pioVar(ifield)%gtype=l3dvar
1586
1587 status=def_var(ng, inlm, dia(ng)%pioFile, &
1588 & dia(ng)%pioVar(ifield)%vd, &
1589 &
pio_fout, nvd4, l3dgrd, aval, vinfo, ncname)
1590 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1591 END IF
1592 END DO
1593
1594
1595
1596 DO ivar=1,ndbio4d
1597 ifield=idbio4(ivar)
1598 IF (dout(ifield,ng)) THEN
1599 vinfo( 1)=vname(1,ifield)
1600 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,ifield))
1601 vinfo( 3)=vname(3,ifield)
1602 vinfo(14)=vname(4,ifield)
1603 vinfo(16)=vname(1,idtime)
1604# if defined WRITE_WATER && defined MASKING
1605 vinfo(20)='mask_rho'
1606# endif
1607 vinfo(21)=vname(6,ifield)
1608 vinfo(22)='coordinates'
1609 aval(5)=real(iinfo(1,ifield,ng),r8)
1610 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1611 dia(ng)%pioVar(ifield)%gtype=l4dvar
1612
1613 status=def_var(ng, inlm, dia(ng)%pioFile, &
1614 & dia(ng)%pioVar(ifield)%vd, &
1615 &
pio_fout, nvd5, l4dgrd, aval, vinfo, ncname)
1616 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1617 END IF
1618 END DO
1619# endif
1620# endif
1621
1622
1623
1624
1625
1627 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1628
1629
1630
1631
1632
1633 CALL wrt_info (ng, inlm, dia(ng)%pioFile, ncname)
1634 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1635 END IF define
1636
1637
1638
1639
1640
1641
1642 query : IF (.not.ldef) THEN
1643 ncname=dia(ng)%name
1644
1645
1646
1648 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1649 WRITE (stdout,50) trim(ncname)
1650 RETURN
1651 END IF
1652
1653
1654
1656 & piofile = dia(ng)%pioFile)
1657 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1658
1659
1660
1662 & piofile = dia(ng)%pioFile)
1663 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1664
1665
1666
1667 DO i=1,nv
1668 got_var(i)=.false.
1669 END DO
1670
1671
1672
1673
1674 DO i=1,n_var
1675 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1676 got_var(idtime)=.true.
1677 dia(ng)%pioVar(idtime)%vd=
var_desc(i)
1678 dia(ng)%pioVar(idtime)%dkind=
pio_tout
1679 dia(ng)%pioVar(idtime)%gtype=0
1680 END IF
1681# ifdef DIAGNOSTICS_UV
1682 DO ivar=1,ndm2d
1683 IF (trim(var_name(i)).eq. &
1684 & trim(vname(1,iddu2d(ivar)))) THEN
1685 got_var(iddu2d(ivar))=.true.
1686 dia(ng)%pioVar(iddu2d(ivar))%vd=
var_desc(i)
1687 dia(ng)%pioVar(iddu2d(ivar))%dkind=
pio_fout
1688 dia(ng)%pioVar(iddu2d(ivar))%gtype=u2dvar
1689 ELSE IF (trim(var_name(i)).eq. &
1690 & trim(vname(1,iddv2d(ivar)))) THEN
1691 got_var(iddv2d(ivar))=.true.
1692 dia(ng)%pioVar(iddv2d(ivar))%vd=
var_desc(i)
1693 dia(ng)%pioVar(iddv2d(ivar))%dkind=
pio_fout
1694 dia(ng)%pioVar(iddv2d(ivar))%gtype=v2dvar
1695 END IF
1696 END DO
1697# ifdef SOLVE3D
1698 DO ivar=1,ndm3d
1699 IF (trim(var_name(i)).eq. &
1700 & trim(vname(1,iddu3d(ivar)))) THEN
1701 got_var(iddu3d(ivar))=.true.
1702 dia(ng)%pioVar(iddu3d(ivar))%vd=
var_desc(i)
1703 dia(ng)%pioVar(iddu3d(ivar))%dkind=
pio_fout
1704 dia(ng)%pioVar(iddu3d(ivar))%gtype=u3dvar
1705 ELSE IF (trim(var_name(i)).eq. &
1706 & trim(vname(1,iddv3d(ivar)))) THEN
1707 got_var(iddv3d(ivar))=.true.
1708 dia(ng)%pioVar(iddv3d(ivar))%vd=
var_desc(i)
1709 dia(ng)%pioVar(iddv3d(ivar))%dkind=
pio_fout
1710 dia(ng)%pioVar(iddv3d(ivar))%gtype=v3dvar
1711 END IF
1712 END DO
1713# endif
1714# endif
1715# ifdef DIAGNOSTICS_TS
1716 DO itrc=1,nt(ng)
1717 DO ivar=1,ndt
1718 ifield=iddtrc(itrc,ivar)
1719 IF (trim(var_name(i)).eq.trim(vname(1,ifield))) THEN
1720 got_var(ifield)=.true.
1721 dia(ng)%pioVar(ifield)%vd=
var_desc(i)
1722 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1723 dia(ng)%pioVar(ifield)%gtype=r3dvar
1724 END IF
1725 END DO
1726 END DO
1727# endif
1728# ifdef DIAGNOSTICS_BIO
1729# if defined BIO_FENNEL || defined HYPOXIA_SRM
1730 DO ivar=1,ndbio2d
1731 ifield=idbio2(ivar)
1732 IF (trim(var_name(i)).eq.trim(vname(1,ifield))) THEN
1733 got_var(ifield)=.true.
1734 dia(ng)%pioVar(ifield)%vd=
var_desc(i)
1735 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1736 dia(ng)%pioVar(ifield)%gtype=r2dvar
1737 END IF
1738 END DO
1739# endif
1740# if defined BIO_FENNEL
1741 DO ivar=1,ndbio3d
1742 ifield=idbio3(ivar)
1743 IF (trim(var_name(i)).eq.trim(vname(1,ifield))) THEN
1744 got_var(ifield)=.true.
1745 dia(ng)%pioVar(ifield)%vd=
var_desc(i)
1746 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1747 dia(ng)%pioVar(ifield)%gtype=r3dvar
1748 END IF
1749 END DO
1750# elif defined ECOSIM
1751 DO ivar=1,ndbio3d
1752 ifield=idbio3(ivar)
1753 IF (trim(var_name(i)).eq.trim(vname(1,ifield))) THEN
1754 got_var(ifield)=.true.
1755 dia(ng)%pioVar(ifield)%vd=
var_desc(i)
1756 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1757 dia(ng)%pioVar(ifield)%gtype=l3dvar
1758 END IF
1759 END DO
1760 DO ivar=1,ndbio4d
1761 ifield=idbio4(ivar)
1762 IF (trim(var_name(i)).eq.trim(vname(1,ifield))) THEN
1763 got_var(ifield)=.true.
1764 dia(ng)%pioVar(ifield)%vd=
var_desc(i)
1765 dia(ng)%pioVar(ifield)%dkind=
pio_fout
1766 dia(ng)%pioVar(ifield)%gtype=l4dvar
1767 END IF
1768 END DO
1769# endif
1770# endif
1771 END DO
1772
1773
1774
1775 IF (.not.got_var(idtime)) THEN
1776 IF (master) WRITE (stdout,60) trim(vname(1,idtime)), &
1777 & trim(ncname)
1778 exit_flag=3
1779 RETURN
1780 END IF
1781# ifdef DIAGNOSTICS_UV
1782 DO ivar=1,ndm2d
1783 ifield=iddu2d(ivar)
1784 IF (.not.got_var(ifield).and.dout(ifield,ng)) THEN
1785 IF (master) WRITE (stdout,60) trim(vname(1,ifield)), &
1786 & trim(ncname)
1787 exit_flag=3
1788 RETURN
1789 END IF
1790 ifield=iddv2d(ivar)
1791 IF (.not.got_var(ifield).and.dout(ifield,ng)) THEN
1792 IF (master) WRITE (stdout,60) trim(vname(1,ifield)), &
1793 & trim(ncname)
1794 exit_flag=3
1795 RETURN
1796 END IF
1797 END DO
1798# ifdef SOLVE3D
1799 DO ivar=1,ndm3d
1800 ifield=iddu3d(ivar)
1801 IF (.not.got_var(ifield).and.dout(ifield,ng)) THEN
1802 IF (master) WRITE (stdout,60) trim(vname(1,ifield)), &
1803 & trim(ncname)
1804 exit_flag=3
1805 RETURN
1806 END IF
1807 ifield=iddv3d(ivar)
1808 IF (.not.got_var(ifield).and.dout(ifield,ng)) THEN
1809 IF (master) WRITE (stdout,60) trim(vname(1,ifield)), &
1810 & trim(ncname)
1811 exit_flag=3
1812 RETURN
1813 END IF
1814 END DO
1815# endif
1816# endif
1817# ifdef DIAGNOSTICS_TS
1818 DO itrc=1,nt(ng)
1819 DO ivar=1,ndt
1820 ifield=iddtrc(itrc,ivar)
1821 IF (.not.got_var(ifield).and.dout(ifield,ng)) THEN
1822 IF (master) WRITE (stdout,60) trim(vname(1,ifield)), &
1823 & trim(ncname)
1824 exit_flag=3
1825 RETURN
1826 END IF
1827 END DO
1828 END DO
1829# endif
1830# ifdef DIAGNOSTICS_BIO
1831# if defined BIO_FENNEL || defined HYPOXIA_SRM
1832 DO ivar=1,ndbio2d
1833 ifield=idbio2(ivar)
1834 IF (.not.got_var(ifield).and.dout(ifield,ng)) THEN
1835 IF (master) WRITE (stdout,60) trim(vname(1,ifield)), &
1836 & trim(ncname)
1837 exit_flag=3
1838 RETURN
1839 END IF
1840 END DO
1841# endif
1842# if defined BIO_FENNEL
1843 DO ivar=1,ndbio3d
1844 ifield=idbio3(ivar)
1845 IF (.not.got_var(ifield).and.dout(ifield,ng)) THEN
1846 IF (master) WRITE (stdout,60) trim(vname(1,ifield)), &
1847 & trim(ncname)
1848 exit_flag=3
1849 RETURN
1850 END IF
1851 END DO
1852# elif defined ECOSIM
1853 DO ivar=1,ndbio3d
1854 ifield=idbio3(ivar)
1855 IF (.not.got_var(ifield).and.dout(ifield,ng)) THEN
1856 IF (master) WRITE (stdout,60) trim(vname(1,ifield)), &
1857 & trim(ncname)
1858 exit_flag=3
1859 RETURN
1860 END IF
1861 END DO
1862 DO ivar=1,ndbio4d
1863 ifield=idbio4(ivar)
1864 IF (.not.got_var(ifield).and.dout(ifield,ng)) THEN
1865 IF (master) WRITE (stdout,60) trim(vname(1,ifield)), &
1866 & trim(ncname)
1867 exit_flag=3
1868 RETURN
1869 END IF
1870 END DO
1871# endif
1872# endif
1873
1874
1875
1876 IF (nrst(ng).eq.ndia(ng)) THEN
1877 IF (ndefdia(ng).gt.0) THEN
1878 dia(ng)%Rindex=((ntstart(ng)-1)- &
1879 & ndefdia(ng)*((ntstart(ng)-1)/ndefdia(ng)))/ &
1880 & ndia(ng)
1881 ELSE
1882 dia(ng)%Rindex=(ntstart(ng)-1)/ndia(ng)
1883 END IF
1884 ELSE
1885 dia(ng)%Rindex=rec_size
1886 END IF
1887 END IF query
1888
1889
1890
1891 IF (ntsdia(ng).eq.1) THEN
1892 diatime(ng)=time(ng)-0.5_r8*real(ndia(ng),r8)*dt(ng)
1893 ELSE
1894 diatime(ng)=time(ng)+real(ntsdia(ng),r8)*dt(ng)- &
1895 & 0.5_r8*real(ndia(ng),r8)*dt(ng)
1896 END IF
1897
1898 10 FORMAT (2x,'DEF_DIAGS_PIO - creating diagnostics file,',t56, &
1899 & 'Grid ',i2.2,': ',a)
1900 20 FORMAT (2x,'DEF_DIAGS_PIO - inquiring diagnostics file,',t56, &
1901 & 'Grid ',i2.2,': ',a)
1902 30 FORMAT (/,' DEF_DIAGS_PIO - unable to create diagnostics NetCDF', &
1903 & ' file: ',a)
1904 40 FORMAT (1pe11.4,1x,'millimeter')
1905 50 FORMAT (/,' DEF_DIAGS_PIO - unable to open diagnostics NetCDF', &
1906 & ' file: ',a)
1907 60 FORMAT (/,' DEF_DIAGS_PIO - unable to find variable: ',a,2x, &
1908 & ' in diagnostics NetCDF file: ',a)
1909
1910 RETURN
integer, parameter pio_fout
type(var_desc_t), dimension(:), pointer var_desc
subroutine, public pio_netcdf_create(ng, model, ncname, piofile)
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
integer, parameter pio_tout
subroutine, public pio_netcdf_enddef(ng, model, ncname, piofile)