1030
1031
1033
1034
1035
1036 integer, intent(in) :: ng, model, ifile
1037
1038
1039
1040 logical :: Ldefine, got_var(NV)
1041
1042 integer, parameter :: Natt = 25
1043
1044 integer :: i, j, nvd3, nvd4
1045 integer :: recdim, status
1046# ifdef ADJUST_BOUNDARY
1047 integer :: IorJdim, ifield
1048# endif
1049 integer :: DimIDs(nDimID)
1050 integer :: t2dgrd(3), u2dgrd(3), v2dgrd(3)
1051# ifdef ADJUST_BOUNDARY
1052 integer :: t2dobc(3)
1053# endif
1054# ifdef SOLVE3D
1055 integer :: itrc
1056
1057 integer :: t3dgrd(4), u3dgrd(4), v3dgrd(4)
1058# ifdef ADJUST_BOUNDARY
1059 integer :: t3dobc(4)
1060# endif
1061# endif
1062
1063 real(r8) :: Aval(6)
1064
1065 character (len=60 ) :: Text
1066 character (len=256) :: ncname
1067 character (len=MaxLen) :: Vinfo(Natt)
1068
1069 character (len=*), parameter :: MyFile = &
1070 & __FILE__//", def_norm_pio"
1071
1072 sourcefile=myfile
1073
1074
1075
1076
1077
1078 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1079 ncname=nrm(ifile,ng)%name
1080
1081 define : IF (ldefnrm(ifile,ng)) THEN
1083 & nrm(ifile,ng)%pioFile)
1084 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1085 IF (master) WRITE (stdout,10) trim(ncname)
1086 RETURN
1087 END IF
1088
1089
1090
1091
1092
1093 dimids=0
1094
1095 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1096 & 'xi_rho', iobounds(ng)%xi_rho, dimids( 1))
1097 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1098
1099 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1100 & 'xi_u',iobounds(ng)%xi_u, dimids( 2))
1101 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1102
1103 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1104 & 'xi_v', iobounds(ng)%xi_v, dimids( 3))
1105 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1106
1107 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1108 & 'xi_psi', iobounds(ng)%xi_psi, dimids( 4))
1109 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1110
1111 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1112 & 'eta_rho', iobounds(ng)%eta_rho, dimids( 5))
1113 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1114
1115 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1116 & 'eta_u', iobounds(ng)%eta_u, dimids( 6))
1117 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1118
1119 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1120 & 'eta_v', iobounds(ng)%eta_v, dimids( 7))
1121 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1122
1123 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1124 & 'eta_psi', iobounds(ng)%eta_psi, dimids( 8))
1125 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1126
1127# ifdef ADJUST_BOUNDARY
1128 IF (ifile.eq.3) THEN
1129 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1130 & 'IorJ', iobounds(ng)%IorJ, iorjdim)
1131 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1132 END IF
1133# endif
1134
1135# if defined WRITE_WATER && defined MASKING
1136 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1137 & 'xy_rho', iobounds(ng)%xy_rho, dimids(17))
1138 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1139
1140 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1141 & 'xy_u', iobounds(ng)%xy_u, dimids(18))
1142 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1143
1144 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname,
1145 & 'xy_v', iobounds(ng)%xy_v, dimids(19))
1146 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1147# endif
1148
1149# ifdef SOLVE3D
1150# if defined WRITE_WATER && defined MASKING
1151 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1152 & 'xyz_rho', iobounds(ng)%xy_rho*n(ng), dimids(20))
1153 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1154
1155 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1156 & 'xyz_u', iobounds(ng)%xy_u*n(ng), dimids(21))
1157 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1158
1159 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1160 & 'xyz_v', iobounds(ng)%xy_v*n(ng), dimids(22))
1161 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1162
1163 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1164 & 'xyz_w', iobounds(ng)%xy_rho*(n(ng)+1), &
1165 & dimids(23))
1166 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1167# endif
1168
1169 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1170 & 's_rho', n(ng), dimids( 9))
1171 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1172
1173 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1174 & 's_w', n(ng)+1, dimids(10))
1175 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1176
1177 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1178 & 'tracer', nt(ng), dimids(11))
1179 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1180
1181# ifdef SEDIMENT
1182 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1183 & 'NST', nst, dimids(32))
1184 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1185
1186 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1187 & 'Nbed', nbed, dimids(16))
1188 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1189
1190# if defined WRITE_WATER && defined MASKING
1191 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1192 & 'xybed', iobounds(ng)%xy_rho*nbed, dimids(24))
1193 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1194# endif
1195# endif
1196
1197# ifdef ECOSIM
1198 status=def_dim(ng, inlm, nrm(ifile,ng)%pioFile, ncname, &
1199 & 'Nbands', nbands, dimids(33))
1200 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1201
1202 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1203 & 'Nphy', nphy, dimids(25))
1204 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1205
1206 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1207 & 'Nbac', nbac, dimids(26))
1208 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1209
1210 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname,
1211 & 'Ndom', ndom, dimids(27))
1212 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1213
1214 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1215 & 'Nfec', nfec, dimids(28))
1216 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1217# endif
1218# endif
1219
1220 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1221 & 'boundary', 4, dimids(14))
1222 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1223
1224# ifdef FOUR_DVAR
1225 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1226 & 'Nstate', nstatevar(ng), dimids(29))
1227 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1228# endif
1229
1230 status=def_dim(ng, itlm, nrm(ifile,ng)%pioFile, ncname, &
1231 & trim(adjustl(vname(5,idtime))), &
1232 & pio_unlimited, dimids(12))
1233 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1234
1235 recdim=dimids(12)
1236
1237
1238
1239# if defined WRITE_WATER && defined MASKING
1240 nvd3=2
1241 nvd4=2
1242# else
1243 nvd3=3
1244 nvd4=4
1245# endif
1246
1247
1248
1249# if defined WRITE_WATER && defined MASKING
1250 t2dgrd(1)=dimids(17)
1251 t2dgrd(2)=dimids(12)
1252# ifdef SOLVE3D
1253 t3dgrd(1)=dimids(20)
1254 t3dgrd(2)=dimids(12)
1255# endif
1256# else
1257 t2dgrd(1)=dimids( 1)
1258 t2dgrd(2)=dimids( 5)
1259 t2dgrd(3)=dimids(12)
1260# ifdef SOLVE3D
1261 t3dgrd(1)=dimids( 1)
1262 t3dgrd(2)=dimids( 5)
1263 t3dgrd(3)=dimids( 9)
1264 t3dgrd(4)=dimids(12)
1265# endif
1266# endif
1267# ifdef ADJUST_BOUNDARY
1268 IF (ifile.eq.3) THEN
1269 t2dobc(1)=iorjdim
1270 t2dobc(2)=dimids(14)
1271 t2dobc(3)=dimids(12)
1272# ifdef SOLVE3D
1273 t3dobc(1)=iorjdim
1274 t3dobc(2)=dimids( 9)
1275 t3dobc(3)=dimids(14)
1276 t3dobc(4)=dimids(12)
1277# endif
1278 END IF
1279# endif
1280
1281
1282
1283# if defined WRITE_WATER && defined MASKING
1284 u2dgrd(1)=dimids(18)
1285 u2dgrd(2)=dimids(12)
1286# ifdef SOLVE3D
1287 u3dgrd(1)=dimids(21)
1288 u3dgrd(2)=dimids(12)
1289# endif
1290# else
1291 u2dgrd(1)=dimids( 2)
1292 u2dgrd(2)=dimids( 6)
1293 u2dgrd(3)=dimids(12)
1294# ifdef SOLVE3D
1295 u3dgrd(1)=dimids( 2)
1296 u3dgrd(2)=dimids( 6)
1297 u3dgrd(3)=dimids( 9)
1298 u3dgrd(4)=dimids(12)
1299# endif
1300# endif
1301
1302
1303
1304# if defined WRITE_WATER && defined MASKING
1305 v2dgrd(1)=dimids(19)
1306 v2dgrd(2)=dimids(12)
1307# ifdef SOLVE3D
1308 v3dgrd(1)=dimids(22)
1309 v3dgrd(2)=dimids(12)
1310# endif
1311# else
1312 v2dgrd(1)=dimids( 3)
1313 v2dgrd(2)=dimids( 7)
1314 v2dgrd(3)=dimids(12)
1315# ifdef SOLVE3D
1316 v3dgrd(1)=dimids( 3)
1317 v3dgrd(2)=dimids( 7)
1318 v3dgrd(3)=dimids( 9)
1319 v3dgrd(4)=dimids(12)
1320# endif
1321# endif
1322
1323
1324
1325 nrm(ifile,ng)%Rindex=0
1326
1327
1328
1329 DO i=1,natt
1330 DO j=1,len(vinfo(1))
1331 vinfo(i)(j:j)=' '
1332 END DO
1333 END DO
1334 DO i=1,6
1335 aval(i)=0.0_r8
1336 END DO
1337
1338
1339
1340
1341
1342 CALL def_info (ng, itlm, nrm(ifile,ng)%pioFile, ncname, dimids)
1343 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1344
1345
1346
1347
1348
1349
1350
1351 vinfo( 1)=vname(1,idtime)
1352 vinfo( 2)=vname(2,idtime)
1353 WRITE (vinfo( 3),'(a,a)') 'seconds since ', trim(rclock%string)
1354 vinfo( 4)=trim(rclock%calendar)
1355 vinfo(14)=vname(4,idtime)
1356 vinfo(21)=vname(6,idtime)
1357 nrm(ifile,ng)%pioVar(idtime)%dkind=
pio_tout
1358 nrm(ifile,ng)%pioVar(idtime)%gtype=0
1359
1360 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1361 & nrm(ifile,ng)%pioVar(idtime)%vd, &
1362 &
pio_tout, 1, (/recdim/), aval, vinfo, ncname, &
1363 & setparaccess = .true.)
1364 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1365
1366
1367
1368
1369
1370 IF ((ifile.eq.1).or.(ifile.eq.2)) THEN
1371 IF (ifile.eq.1) THEN
1372 text='initial conditions error covariance normalization'
1373 ELSE IF (ifile.eq.2) THEN
1374 text='model error covariance normalization'
1375 END IF
1376
1377
1378
1379 vinfo( 1)=vname(1,idfsur)
1380 WRITE (vinfo( 2),20) trim(vname(2,idfsur)), trim(text)
1381 vinfo( 3)='nondimensional'
1382 vinfo(14)=vname(4,idfsur)
1383 vinfo(16)=vname(1,idtime)
1384# if defined WRITE_WATER && defined MASKING
1385 vinfo(20)='mask_rho'
1386# endif
1387 vinfo(21)=vname(6,idfsur)
1388 vinfo(22)='coordinates'
1389 aval(5)=real(iinfo(1,idfsur,ng),r8)
1390 nrm(ifile,ng)%pioVar(idfsur)%dkind=
pio_fout
1391 nrm(ifile,ng)%pioVar(idfsur)%gtype=r2dvar
1392
1393 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1394 & nrm(ifile,ng)%pioVar(idfsur)%vd, &
1395 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
1396 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1397
1398
1399
1400 vinfo( 1)=vname(1,idubar)
1401 WRITE (vinfo( 2),20) trim(vname(2,idubar)), trim(text)
1402 vinfo( 3)='nondimensional'
1403 vinfo(14)=vname(4,idubar)
1404 vinfo(16)=vname(1,idtime)
1405# if defined WRITE_WATER && defined MASKING
1406 vinfo(20)='mask_u'
1407# endif
1408 vinfo(21)=vname(6,idubar)
1409 vinfo(22)='coordinates'
1410 aval(5)=real(iinfo(1,idubar,ng),r8)
1411 nrm(ifile,ng)%pioVar(idubar)%dkind=
pio_fout
1412 nrm(ifile,ng)%pioVar(idubar)%gtype=u2dvar
1413
1414 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1415 & nrm(ifile,ng)%pioVar(idubar)%vd, &
1416 &
pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
1417 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1418
1419
1420
1421 vinfo( 1)=vname(1,idvbar)
1422 WRITE (vinfo( 2),20) trim(vname(2,idvbar)), trim(text)
1423 vinfo( 3)='nondimensional'
1424 vinfo(14)=vname(4,idvbar)
1425 vinfo(16)=vname(1,idtime)
1426# if defined WRITE_WATER && defined MASKING
1427 vinfo(20)='mask_v'
1428# endif
1429 vinfo(21)=vname(6,idvbar)
1430 vinfo(22)='coordinates'
1431 aval(5)=real(iinfo(1,idvbar,ng),r8)
1432 nrm(ifile,ng)%pioVar(idvbar)%dkind=
pio_fout
1433 nrm(ifile,ng)%pioVar(idvbar)%gtype=v2dvar
1434
1435 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1436 & nrm(ifile,ng)%pioVar(idvbar)%vd, &
1437 &
pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
1438 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1439
1440# ifdef SOLVE3D
1441
1442
1443
1444 vinfo( 1)=vname(1,iduvel)
1445 WRITE (vinfo( 2),20) trim(vname(2,iduvel)), trim(text)
1446 vinfo( 3)='nondimensional'
1447 vinfo(14)=vname(4,iduvel)
1448 vinfo(16)=vname(1,idtime)
1449# if defined WRITE_WATER && defined MASKING
1450 vinfo(20)='mask_u'
1451# endif
1452 vinfo(21)=vname(6,iduvel)
1453 vinfo(22)='coordinates'
1454 aval(5)=real(iinfo(1,iduvel,ng),r8)
1455 nrm(ifile,ng)%pioVar(iduvel)%dkind=
pio_fout
1456 nrm(ifile,ng)%pioVar(iduvel)%gtype=u3dvar
1457
1458 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1459 & nrm(ifile,ng)%pioVar(iduvel)%vd, &
1460 &
pio_fout, nvd4, u3dgrd, aval, vinfo, ncname)
1461 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1462
1463
1464
1465 vinfo( 1)=vname(1,idvvel)
1466 WRITE (vinfo( 2),20) trim(vname(2,idvvel)), trim(text)
1467 vinfo( 3)='nondimensional'
1468 vinfo(14)=vname(4,idvvel)
1469 vinfo(16)=vname(1,idtime)
1470# if defined WRITE_WATER && defined MASKING
1471 vinfo(20)='mask_v'
1472# endif
1473 vinfo(21)=vname(6,idvvel)
1474 vinfo(22)='coordinates'
1475 aval(5)=real(iinfo(1,idvvel,ng),r8)
1476 nrm(ifile,ng)%pioVar(idvvel)%dkind=
pio_fout
1477 nrm(ifile,ng)%pioVar(idvvel)%gtype=v3dvar
1478
1479 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1480 & nrm(ifile,ng)%pioVar(idvvel)%vd, &
1481 &
pio_fout, nvd4, v3dgrd, aval, vinfo, ncname)
1482 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1483
1484
1485
1486 DO itrc=1,nt(ng)
1487 vinfo( 1)=vname(1,idtvar(itrc))
1488 WRITE (vinfo( 2),20) trim(vname(2,idtvar(itrc))), trim(text)
1489 vinfo( 3)='nondimensional'
1490 vinfo(14)=vname(4,idtvar(itrc))
1491 vinfo(16)=vname(1,idtime)
1492# ifdef SEDIMENT
1493 DO i=1,nst
1494 IF (itrc.eq.idsed(i)) THEN
1495 WRITE (vinfo(19),30) 1000.0_r8*sd50(i,ng)
1496 END IF
1497 END DO
1498# endif
1499# if defined WRITE_WATER && defined MASKING
1500 vinfo(20)='mask_rho'
1501# endif
1502 vinfo(21)=vname(6,idtvar(itrc))
1503 vinfo(22)='coordinates'
1504 aval(5)=real(r3dvar,r8)
1505 nrm(ifile,ng)%pioTrc(itrc)%dkind=
pio_fout
1506 nrm(ifile,ng)%pioTrc(itrc)%gtype=r3dvar
1507
1508 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1509 & nrm(ifile,ng)%pioTrc(itrc)%vd, &
1510 &
pio_fout, nvd4, t3dgrd, aval, vinfo, ncname)
1511 END DO
1512 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1513# endif
1514
1515# ifdef ADJUST_BOUNDARY
1516
1517
1518
1519
1520
1521 ELSE IF (ifile.eq.3) THEN
1522 text='error covariance normalization'
1523
1524
1525
1526 IF (any(lobc(:,isfsur,ng))) THEN
1527 ifield=idsbry(isfsur)
1528 vinfo( 1)=vname(1,ifield)
1529 WRITE (vinfo( 2),20) trim(vname(2,ifield)), trim(text)
1530 vinfo( 3)=vname(3,ifield)
1531 vinfo(14)=vname(4,ifield)
1532 vinfo(16)=vname(1,idtime)
1533 vinfo(21)=vname(6,ifield)
1534 aval(5)=real(iinfo(1,ifield,ng),r8)
1535 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1536 nrm(ifile,ng)%pioVar(ifield)%gtype=r2dobc
1537
1538 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1539 & nrm(ifile,ng)%pioVar(ifield)%vd, &
1540 &
pio_fout, 3, t2dobc, aval, vinfo, ncname, &
1541 & setfillval = .false.)
1542 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1543 END IF
1544
1545
1546
1547 IF (any(lobc(:,isubar,ng))) THEN
1548 ifield=idsbry(isubar)
1549 vinfo( 1)=vname(1,ifield)
1550 WRITE (vinfo( 2),20) trim(vname(2,ifield)), trim(text)
1551 vinfo( 3)=vname(3,ifield)
1552 vinfo(14)=vname(4,ifield)
1553 vinfo(16)=vname(1,idtime)
1554 vinfo(21)=vname(6,ifield)
1555 aval(5)=real(iinfo(1,ifield,ng),r8)
1556 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1557 nrm(ifile,ng)%pioVar(ifield)%gtype=u2dobc
1558
1559 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1560 & nrm(ifile,ng)%pioVar(ifield)%vd, &
1561 &
pio_fout, 3, t2dobc, aval, vinfo, ncname, &
1562 & setfillval = .false.)
1563 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1564 END IF
1565
1566
1567
1568 IF (any(lobc(:,isvbar,ng))) THEN
1569 ifield=idsbry(isvbar)
1570 vinfo( 1)=vname(1,ifield)
1571 WRITE (vinfo( 2),20) trim(vname(2,ifield)), trim(text)
1572 vinfo( 3)=vname(3,ifield)
1573 vinfo(14)=vname(4,ifield)
1574 vinfo(16)=vname(1,idtime)
1575 vinfo(21)=vname(6,ifield)
1576 aval(5)=real(iinfo(1,ifield,ng),r8)
1577 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1578 nrm(ifile,ng)%pioVar(ifield)%gtype=v2dobc
1579
1580 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1581 & nrm(ifile,ng)%pioVar(ifield)%vd, &
1582 &
pio_fout, 3, t2dobc, aval, vinfo, ncname, &
1583 & setfillval = .false.)
1584 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1585 END IF
1586
1587# ifdef SOLVE3D
1588
1589
1590
1591 IF (any(lobc(:,isuvel,ng))) THEN
1592 ifield=idsbry(isuvel)
1593 vinfo( 1)=vname(1,ifield)
1594 WRITE (vinfo( 2),20) trim(vname(2,ifield)), trim(text)
1595 vinfo( 3)=vname(3,ifield)
1596 vinfo(14)=vname(4,ifield)
1597 vinfo(16)=vname(1,idtime)
1598 vinfo(21)=vname(6,ifield)
1599 aval(5)=real(iinfo(1,ifield,ng),r8)
1600 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1601 nrm(ifile,ng)%pioVar(ifield)%gtype=u3dobc
1602
1603 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1604 & nrm(ifile,ng)%pioVar(ifield)%vd, &
1605 &
pio_fout, 4, t3dobc, aval, vinfo, ncname, &
1606 & setfillval = .false.)
1607 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1608 END IF
1609
1610
1611
1612 IF (any(lobc(:,isvvel,ng))) THEN
1613 ifield=idsbry(isvvel)
1614 vinfo( 1)=vname(1,ifield)
1615 WRITE (vinfo( 2),20) trim(vname(2,ifield)), trim(text)
1616 vinfo( 3)=vname(3,ifield)
1617 vinfo(14)=vname(4,ifield)
1618 vinfo(16)=vname(1,idtime)
1619 vinfo(21)=vname(6,ifield)
1620 aval(5)=real(iinfo(1,ifield,ng),r8)
1621 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1622 nrm(ifile,ng)%pioVar(ifield)%gtype=v3dobc
1623
1624 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1625 & nrm(ifile,ng)%pioVar(ifield)%vd, &
1626 &
pio_fout, 4, t3dobc, aval, vinfo, ncname, &
1627 & setfillval = .false.)
1628 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1629 END IF
1630
1631
1632
1633 DO itrc=1,nt(ng)
1634 IF (any(lobc(:,istvar(itrc),ng))) THEN
1635 ifield=idsbry(istvar(itrc))
1636 vinfo( 1)=vname(1,ifield)
1637 WRITE (vinfo( 2),20) trim(vname(2,ifield)), trim(text)
1638 vinfo( 3)=vname(3,ifield)
1639 vinfo(14)=vname(4,ifield)
1640 vinfo(16)=vname(1,idtime)
1641# ifdef SEDIMENT
1642 DO i=1,nst
1643 IF (itrc.eq.idsed(i)) THEN
1644 WRITE (vinfo(19),30) 1000.0_r8*sd50(i,ng)
1645 END IF
1646 END DO
1647# endif
1648 vinfo(21)=vname(6,ifield)
1649 aval(5)=real(iinfo(1,ifield,ng),r8)
1650 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1651 nrm(ifile,ng)%pioVar(ifield)%gtype=r3dobc
1652
1653 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1654 & nrm(ifile,ng)%pioVar(ifield)%vd, &
1655 &
pio_fout, 4, t3dobc, aval, vinfo, ncname, &
1656 & setfillval = .false.)
1657 IF (founderror(exit_flag, noerror, &
1658 & __line__, myfile)) RETURN
1659 END IF
1660 END DO
1661# endif
1662# endif
1663
1664# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1665
1666
1667
1668
1669
1670 ELSE IF (ifile.eq.4) THEN
1671 text='error covariance normalization'
1672
1673# ifdef ADJUST_WSTRESS
1674
1675
1676
1677 vinfo( 1)=vname(1,idusms)
1678 WRITE (vinfo( 2),20) trim(vname(2,idusms)), trim(text)
1679 vinfo( 3)='nondimensional'
1680 vinfo(14)=vname(4,idusms)
1681 vinfo(16)=vname(1,idtime)
1682# if defined WRITE_WATER && defined MASKING
1683 vinfo(20)='mask_u'
1684# endif
1685 vinfo(21)=vname(6,idusms)
1686 vinfo(22)='coordinates'
1687 aval(5)=real(u2dvar,r8)
1688 nrm(ifile,ng)%pioVar(idusms)%dkind=
pio_fout
1689 nrm(ifile,ng)%pioVar(idusms)%gtype=u2dvar
1690
1691 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1692 & nrm(ifile,ng)%pioVar(idusms)%vd, &
1693 &
pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
1694 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1695
1696
1697
1698 vinfo( 1)=vname(1,idvsms)
1699 WRITE (vinfo( 2),20) trim(vname(2,idvsms)), trim(text)
1700 vinfo( 2)=vname(2,idvsms)
1701 vinfo( 3)='nondimensional'
1702 vinfo(14)=vname(4,idvsms)
1703 vinfo(16)=vname(1,idtime)
1704# if defined WRITE_WATER && defined MASKING
1705 vinfo(20)='mask_v'
1706# endif
1707 vinfo(21)=vname(6,idvsms)
1708 vinfo(22)='coordinates'
1709 aval(5)=real(v2dvar,r8)
1710 nrm(ifile,ng)%pioVar(idvsms)%dkind=
pio_fout
1711 nrm(ifile,ng)%pioVar(idvsms)%gtype=v2dvar
1712
1713 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1714 & nrm(ifile,ng)%pioVar(idvsms)%vd, &
1715 &
pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
1716 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1717# endif
1718
1719# if defined ADJUST_STFLUX && defined SOLVE3D
1720
1721
1722
1723 DO itrc=1,nt(ng)
1724 IF (lstflux(itrc,ng)) THEN
1725 vinfo( 1)=vname(1,idtsur(itrc))
1726 WRITE (vinfo( 2),20) trim(vname(2,idtsur(itrc))), &
1727 & trim(text)
1728 vinfo( 3)='nondimensional'
1729 vinfo(14)=vname(4,idtsur(itrc))
1730 vinfo(16)=vname(1,idtime)
1731# if defined WRITE_WATER && defined MASKING
1732 vinfo(20)='mask_rho'
1733# endif
1734 vinfo(21)=vname(6,idtsur(itrc))
1735 vinfo(22)='coordinates'
1736 aval(5)=real(r2dvar,r8)
1737 nrm(ifile,ng)%pioVar(idtsur(itrc))%dkind=
pio_fout
1738 nrm(ifile,ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1739
1740 status=def_var(ng, itlm, nrm(ifile,ng)%pioFile, &
1741 & nrm(ifile,ng)%pioVar(idtsur(itrc))%vd, &
1742 &
pio_fout, nvd3, t2dgrd, aval, vinfo, &
1743 & ncname)
1744 IF (founderror(exit_flag, noerror, &
1745 & __line__, myfile)) RETURN
1746 END IF
1747 END DO
1748# endif
1749# endif
1750 END IF
1751
1752
1753
1754
1755
1757 & nrm(ifile,ng)%pioFile)
1758 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1759
1760
1761
1762
1763
1764
1765 CALL wrt_info (ng, model, nrm(ifile,ng)%pioFile, ncname)
1766 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1767 ldefnrm(ifile,ng)=.false.
1768 END IF define
1769
1770
1771
1772
1773
1774
1775 query : IF (.not.ldefnrm(ifile,ng)) THEN
1776 ncname=nrm(ifile,ng)%name
1777
1778
1779
1781 & nrm(ifile,ng)%pioFile)
1782 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1783 WRITE (stdout,40) trim(ncname)
1784 RETURN
1785 END IF
1786
1787
1788
1790 & piofile = nrm(ifile,ng)%pioFile)
1791 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1792
1793
1794
1796 & piofile = nrm(ifile,ng)%pioFile)
1797 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1798
1799
1800
1801 DO i=1,nv
1802 got_var(i)=.false.
1803 END DO
1804
1805
1806
1807
1808 DO i=1,n_var
1809 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1810 got_var(idtime)=.true.
1811 nrm(ifile,ng)%pioVar(idtime)%vd=
var_desc(i)
1812 nrm(ifile,ng)%pioVar(idtime)%dkind=
pio_tout
1813 nrm(ifile,ng)%pioVar(idtime)%gtype=0
1814 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
1815 got_var(idfsur)=.true.
1816 nrm(ifile,ng)%pioVar(idfsur)%vd=
var_desc(i)
1817 nrm(ifile,ng)%pioVar(idfsur)%dkind=
pio_fout
1818 nrm(ifile,ng)%pioVar(idfsur)%gtype=r2dvar
1819 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
1820 got_var(idubar)=.true.
1821 nrm(ifile,ng)%pioVar(idubar)%vd=
var_desc(i)
1822 nrm(ifile,ng)%pioVar(idubar)%dkind=
pio_fout
1823 nrm(ifile,ng)%pioVar(idubar)%gtype=u2dvar
1824 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
1825 got_var(idvbar)=.true.
1826 nrm(ifile,ng)%pioVar(idvbar)%vd=
var_desc(i)
1827 nrm(ifile,ng)%pioVar(idvbar)%dkind=
pio_fout
1828 nrm(ifile,ng)%pioVar(idvbar)%gtype=v2dvar
1829# ifdef ADJUST_BOUNDARY
1830 ELSE IF (trim(var_name(i)).eq. &
1831 & trim(vname(1,idsbry(isfsur)))) THEN
1832 ifield=idsbry(isfsur)
1833 got_var(ifield)=.true.
1834 nrm(ifile,ng)%pioVar(ifield)%vd=
var_desc(i)
1835 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1836 nrm(ifile,ng)%pioVar(ifield)%gtype=r2dobc
1837 ELSE IF (trim(var_name(i)).eq. &
1838 & trim(vname(1,idsbry(isubar)))) THEN
1839 ifield=idsbry(isubar)
1840 got_var(ifield)=.true.
1841 nrm(ifile,ng)%pioVar(ifield)%vd=
var_desc(i)
1842 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1843 nrm(ifile,ng)%pioVar(ifield)%gtype=u2dobc
1844 ELSE IF (trim(var_name(i)).eq. &
1845 & trim(vname(1,idsbry(isvbar)))) THEN
1846 ifield=idsbry(isvbar)
1847 got_var(ifield)=.true.
1848 nrm(ifile,ng)%pioVar(ifield)%vd=
var_desc(i)
1849 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1850 nrm(ifile,ng)%pioVar(ifield)%gtype=v2dobc
1851# endif
1852# ifdef SOLVE3D
1853 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
1854 got_var(iduvel)=.true.
1855 nrm(ifile,ng)%pioVar(iduvel)%vd=
var_desc(i)
1856 nrm(ifile,ng)%pioVar(iduvel)%dkind=
pio_fout
1857 nrm(ifile,ng)%pioVar(iduvel)%gtype=u3dvar
1858 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
1859 got_var(idvvel)=.true.
1860 nrm(ifile,ng)%pioVar(idvvel)%vd=
var_desc(i)
1861 nrm(ifile,ng)%pioVar(idvvel)%dkind=
pio_fout
1862 nrm(ifile,ng)%pioVar(idvvel)%gtype=v3dvar
1863# ifdef ADJUST_BOUNDARY
1864 ELSE IF (trim(var_name(i)).eq. &
1865 & trim(vname(1,idsbry(isuvel)))) THEN
1866 ifield=idsbry(isuvel)
1867 got_var(ifield)=.true.
1868 nrm(ifile,ng)%pioVar(ifield)%vd=
var_desc(i)
1869 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1870 nrm(ifile,ng)%pioVar(ifield)%gtype=u3dobc
1871 ELSE IF (trim(var_name(i)).eq. &
1872 & trim(vname(1,idsbry(isvvel)))) THEN
1873 ifield=idsbry(isvvel)
1874 got_var(ifield)=.true.
1875 nrm(ifile,ng)%pioVar(ifield)%vd=
var_desc(i)
1876 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1877 nrm(ifile,ng)%pioVar(ifield)%gtype=v3dobc
1878# endif
1879# endif
1880# ifdef ADJUST_WSTRESS
1881 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
1882 got_var(idusms)=.true.
1883 nrm(ifile,ng)%pioVar(idusms)%vd=
var_desc(i)
1884 nrm(ifile,ng)%pioVar(idusms)%dkind=
pio_fout
1885 nrm(ifile,ng)%pioVar(idusms)%gtype=u2dvar
1886 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
1887 got_var(idvsms)=.true.
1888 nrm(ifile,ng)%pioVar(idvsms)%vd=
var_desc(i)
1889 nrm(ifile,ng)%pioVar(idvsms)%dkind=
pio_fout
1890 nrm(ifile,ng)%pioVar(idvsms)%gtype=v2dvar
1891# endif
1892 END IF
1893# ifdef SOLVE3D
1894 DO itrc=1,nt(ng)
1895 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
1896 got_var(idtvar(itrc))=.true.
1897 nrm(ifile,ng)%pioTrc(itrc)%vd=
var_desc(i)
1898 nrm(ifile,ng)%pioTrc(itrc)%dkind=
pio_fout
1899 nrm(ifile,ng)%pioTrc(itrc)%gtype=r3dvar
1900# ifdef ADJUST_BOUNDARY
1901 ELSE IF (trim(var_name(i)).eq. &
1902 & trim(vname(1,idsbry(istvar(itrc))))) THEN
1903 ifield=idsbry(istvar(itrc))
1904 got_var(ifield)=.true.
1905 nrm(ifile,ng)%pioVar(ifield)%vd=
var_desc(i)
1906 nrm(ifile,ng)%pioVar(ifield)%dkind=
pio_fout
1907 nrm(ifile,ng)%pioVar(ifield)%gtype=r3dobc
1908# endif
1909# ifdef ADJUST_STFLUX
1910 ELSE IF (trim(var_name(i)).eq. &
1911 & trim(vname(1,idtsur(itrc)))) THEN
1912 got_var(idtsur(itrc))=.true.
1913 nrm(ifile,ng)%pioVar(idtsur(itrc))%vd=
var_desc(i)
1914 nrm(ifile,ng)%pioVar(idtsur(itrc))%dkind=
pio_fout
1915 nrm(ifile,ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1916# endif
1917 END IF
1918 END DO
1919# endif
1920 END DO
1921
1922
1923
1924
1925 IF (.not.got_var(idtime)) THEN
1926 IF (master) WRITE (stdout,50) trim(vname(1,idtime)), &
1927 & trim(ncname)
1928 exit_flag=3
1929 RETURN
1930 END IF
1931 IF (.not.got_var(idfsur).and.(ifile.le.2)) THEN
1932 IF (master) WRITE (stdout,50) trim(vname(1,idfsur)), &
1933 & trim(ncname)
1934 exit_flag=3
1935 RETURN
1936 END IF
1937 IF (.not.got_var(idubar).and.(ifile.le.2)) THEN
1938 IF (master) WRITE (stdout,50) trim(vname(1,idubar)), &
1939 & trim(ncname)
1940 exit_flag=3
1941 RETURN
1942 END IF
1943 IF (.not.got_var(idvbar).and.(ifile.le.2)) THEN
1944 IF (master) WRITE (stdout,50) trim(vname(1,idvbar)), &
1945 & trim(ncname)
1946 exit_flag=3
1947 RETURN
1948 END IF
1949# ifdef ADJUST_BOUNDARY
1950 IF (.not.got_var(idsbry(isfsur)).and.(ifile.eq.3)) THEN
1951 IF (master) WRITE (stdout,50) trim(vname(1,idsbry(isfsur))), &
1952 & trim(ncname)
1953 exit_flag=3
1954 RETURN
1955 END IF
1956 IF (.not.got_var(idsbry(isubar)).and.(ifile.eq.3)) THEN
1957 IF (master) WRITE (stdout,50) trim(vname(1,idsbry(isubar))), &
1958 & trim(ncname)
1959 exit_flag=3
1960 RETURN
1961 END IF
1962 IF (.not.got_var(idsbry(isvbar)).and.(ifile.eq.3)) THEN
1963 IF (master) WRITE (stdout,50) trim(vname(1,idsbry(isvbar))), &
1964 & trim(ncname)
1965 exit_flag=3
1966 RETURN
1967 END IF
1968# endif
1969# ifdef SOLVE3D
1970 IF (.not.got_var(iduvel).and.(ifile.le.2)) THEN
1971 IF (master) WRITE (stdout,50) trim(vname(1,iduvel)), &
1972 & trim(ncname)
1973 exit_flag=3
1974 RETURN
1975 END IF
1976 IF (.not.got_var(idvvel).and.(ifile.le.2)) THEN
1977 IF (master) WRITE (stdout,50) trim(vname(1,idvvel)), &
1978 & trim(ncname)
1979 exit_flag=3
1980 RETURN
1981 END IF
1982# ifdef ADJUST_BOUNDARY
1983 IF (.not.got_var(idsbry(isuvel)).and.(ifile.eq.3)) THEN
1984 IF (master) WRITE (stdout,50) trim(vname(1,idsvar(isuvel))), &
1985 & trim(ncname)
1986 exit_flag=3
1987 RETURN
1988 END IF
1989 IF (.not.got_var(idsbry(isvvel)).and.(ifile.eq.3)) THEN
1990 IF (master) WRITE (stdout,50) trim(vname(1,idsvar(isvvel))), &
1991 & trim(ncname)
1992 exit_flag=3
1993 RETURN
1994 END IF
1995# endif
1996# endif
1997# ifdef ADJUST_WSTRESS
1998 IF (.not.got_var(idusms).and.(ifile.eq.4)) THEN
1999 IF (master) WRITE (stdout,50) trim(vname(1,idusms)), &
2000 & trim(ncname)
2001 exit_flag=3
2002 RETURN
2003 END IF
2004 IF (.not.got_var(idvsms).and.(ifile.eq.4)) THEN
2005 IF (master) WRITE (stdout,50) trim(vname(1,idvsms)), &
2006 & trim(ncname)
2007 exit_flag=3
2008 RETURN
2009 END IF
2010# endif
2011# ifdef SOLVE3D
2012 DO itrc=1,nt(ng)
2013 IF (.not.got_var(idtvar(itrc)).and.(ifile.le.2)) THEN
2014 IF (master) WRITE (stdout,50) trim(vname(1,idtvar(itrc))), &
2015 & trim(ncname)
2016 exit_flag=3
2017 RETURN
2018 END IF
2019# ifdef ADJUST_BOUNDARY
2020 IF (.not.got_var(idsbry(istvar(itrc))).and.(ifile.eq.3)) THEN
2021 IF (master) WRITE (stdout,50) &
2022 & trim(vname(1,idsbry(istvar(itrc)))), &
2023 & trim(ncname)
2024 exit_flag=3
2025 RETURN
2026 END IF
2027# endif
2028# ifdef ADJUST_STFLUX
2029 IF (.not.got_var(idtsur(itrc)).and.(ifile.eq.4).and. &
2030 & lstflux(itrc,ng)) THEN
2031 IF (master) WRITE (stdout,50) trim(vname(1,idtsur(itrc))), &
2032 & trim(ncname)
2033 exit_flag=3
2034 RETURN
2035 END IF
2036# endif
2037 END DO
2038# endif
2039
2040
2041
2042
2043 nrm(ifile,ng)%Rindex=0
2044 END IF query
2045
2046 10 FORMAT (/,' DEF_NORM_PIO - unable to create norm NetCDF', &
2047 & ' file: ',a)
2048 20 FORMAT (a,', ',a)
2049 30 FORMAT (1pe11.4,1x,'millimeter')
2050 40 FORMAT (/,' DEF_NORM_PIO - unable to open norm NetCDF file: ',a)
2051 50 FORMAT (/,' DEF_NORM_PIO - unable to find variable: ',a,2x, &
2052 & ' in norm NetCDF file: ',a)
2053
2054 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)