888
889
891
892
893
894 integer, intent(in) :: ng
895
896
897
898# ifdef ADJUST_BOUNDARY
899 logical :: got_IorJ, got_boundary, got_obc_adjust
900# endif
901# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
902 logical :: got_frc_adjust
903# endif
904 logical :: got_var(NV)
905 logical :: Ldefine = .false.
906
907 integer, parameter :: Natt = 25
908
909 integer :: i, j, ifield, itrc, status
910 integer :: Fcount
911# ifdef ADJUST_BOUNDARY
912 integer :: IorJdim, brecdim, brecsize
913# endif
914# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
915 integer :: frecdim, frecsize
916# endif
917 integer :: DimIDs(nDimID)
918# ifdef ADJUST_BOUNDARY
919 integer :: t2dobc(4)
920# ifdef SOLVE3D
921 integer :: t3dobc(5)
922# endif
923# endif
924# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
925 integer :: t4dfrc(4), u4dfrc(4), v4dfrc(4)
926# endif
927
928 real(r8) :: Aval(6)
929
930 character (len=256) :: ncname
931 character (len=MaxLen) :: Vinfo(Natt)
932
933 character (len=*), parameter :: MyFile = &
934 & __FILE__//", def_ini_pio"
935
936 sourcefile=myfile
937
938# if !defined CORRELATION && \
939 (defined adjust_boundary || defined adjust_stflux || \
940 defined adjust_wstress)
941
942
943
944
945
946
947 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
948 ncname=ini(ng)%name
949
950
951
953 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
954 IF (master) WRITE (stdout,10) trim(ncname)
955 RETURN
956 END IF
957
958
959
961 & piofile = ini(ng)%pioFile)
962 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
963
964
965
967 & piofile = ini(ng)%pioFile)
968 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
969
970
971
972 DO i=1,nv
973 got_var(i)=.false.
974 END DO
975
976 DO i=1,n_var
977# ifdef ADJUST_BOUNDARY
978 IF (trim(var_name(i)).eq. &
979 & trim(vname(1,idsbry(isfsur)))) THEN
980 got_var(idsbry(isfsur))=.true.
981 ini(ng)%pioVar(idsbry(isfsur))%vd=
var_desc(i)
982 ini(ng)%pioVar(idsbry(isfsur))%dkind=
pio_fout
983 ini(ng)%pioVar(idsbry(isfsur))%gtype=r2dobc
984 ELSE IF (trim(var_name(i)).eq. &
985 & trim(vname(1,idsbry(isubar)))) THEN
986 got_var(idsbry(isubar))=.true.
987 ini(ng)%pioVar(idsbry(isubar))%vd=
var_desc(i)
988 ini(ng)%pioVar(idsbry(isubar))%dkind=
pio_fout
989 ini(ng)%pioVar(idsbry(isubar))%gtype=u2dobc
990 ELSE IF (trim(var_name(i)).eq. &
991 & trim(vname(1,idsbry(isvbar)))) THEN
992 got_var(idsbry(isvbar))=.true.
993 ini(ng)%pioVar(idsbry(isvbar))%vd=
var_desc(i)
994 ini(ng)%pioVar(idsbry(isvbar))%dkind=
pio_fout
995 ini(ng)%pioVar(idsbry(isvbar))%gtype=v2dobc
996# ifdef SOLVE3D
997 ELSE IF (trim(var_name(i)).eq. &
998 & trim(vname(1,idsbry(isuvel)))) THEN
999 got_var(idsbry(isuvel))=.true.
1000 ini(ng)%pioVar(idsbry(isuvel))%vd=
var_desc(i)
1001 ini(ng)%pioVar(idsbry(isuvel))%dkind=
pio_fout
1002 ini(ng)%pioVar(idsbry(isuvel))%gtype=u3dobc
1003 ELSE IF (trim(var_name(i)).eq. &
1004 & trim(vname(1,idsbry(isvvel)))) THEN
1005 got_var(idsbry(isvvel))=.true.
1006 ini(ng)%pioVar(idsbry(isvvel))%vd=
var_desc(i)
1007 ini(ng)%pioVar(idsbry(isvvel))%dkind=
pio_fout
1008 ini(ng)%pioVar(idsbry(isvvel))%gtype=v3dobc
1009# endif
1010 END IF
1011# ifdef SOLVE3D
1012 DO itrc=1,nt(ng)
1013 IF (trim(var_name(i)).eq. &
1014 & trim(vname(1,idsbry(istvar(itrc))))) THEN
1015 got_var(idsbry(istvar(itrc)))=.true.
1016 ini(ng)%pioVar(idsbry(istvar(itrc)))%vd=
var_desc(i)
1017 ini(ng)%pioVar(idsbry(istvar(itrc)))%dkind=
pio_fout
1018 ini(ng)%pioVar(idsbry(istvar(itrc)))%gtype=r3dobc
1019 END IF
1020 END DO
1021# endif
1022# endif
1023# ifdef ADJUST_WSTRESS
1024 IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
1025 got_var(idusms)=.true.
1026 ini(ng)%pioVar(idusms)%vd=
var_desc(i)
1027 ini(ng)%pioVar(idusms)%dkind=
pio_fout
1028 ini(ng)%pioVar(idusms)%gtype=u2dvar
1029 IF (var_ndim(i).ne.4) THEN
1030 IF (master) THEN
1031 WRITE (stdout,20) trim(vname(1,idusms)), &
1032 & var_ndim(i), 'frc_adjust', &
1033 & trim(ncname)
1034 END IF
1035 exit_flag=2
1036 RETURN
1037 END IF
1038 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
1039 got_var(idvsms)=.true.
1040 ini(ng)%pioVar(idvsms)%vd=
var_desc(i)
1041 ini(ng)%pioVar(idvsms)%dkind=
pio_fout
1042 ini(ng)%pioVar(idvsms)%gtype=v2dvar
1043 IF (var_ndim(i).ne.4) THEN
1044 IF (master) THEN
1045 WRITE (stdout,20) trim(vname(1,idvsms)), &
1046 & var_ndim(i), 'frc_adjust', &
1047 & trim(ncname)
1048 END IF
1049 exit_flag=2
1050 RETURN
1051 END IF
1052 END IF
1053# endif
1054# if defined ADJUST_STFLUX && defined SOLVE3D
1055 DO itrc=1,nt(ng)
1056 IF (lstflux(itrc,ng)) THEN
1057 IF (trim(var_name(i)).eq.trim(vname(1,idtsur(itrc)))) THEN
1058 got_var(idtsur(itrc))=.true.
1059 ini(ng)%pioVar(idtsur(itrc))%vd=
var_desc(i)
1060 ini(ng)%pioVar(idtsur(itrc))%dkind=
pio_fout
1061 ini(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1062 IF (var_ndim(i).ne.4) THEN
1063 IF (master) THEN
1064 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
1065 & var_ndim(i), 'frc_adjust', &
1066 & trim(ncname)
1067 END IF
1068 exit_flag=2
1069 RETURN
1070 END IF
1071 END IF
1072 END IF
1073 END DO
1074# endif
1075 END DO
1076
1077# ifdef ADJUST_BOUNDARY
1078 IF (.not.got_var(idsbry(isfsur))) ldefine=.true.
1079 IF (.not.got_var(idsbry(isubar))) ldefine=.true.
1080 IF (.not.got_var(idsbry(isvbar))) ldefine=.true.
1081# ifdef SOLVE3D
1082 IF (.not.got_var(idsbry(isuvel))) ldefine=.true.
1083 IF (.not.got_var(idsbry(isvvel))) ldefine=.true.
1084 DO itrc=1,nt(ng)
1085 IF (.not.got_var(idsbry(istvar(itrc))).and. &
1086 & any(lobc(:,istvar(itrc),ng))) ldefine=.true.
1087 END DO
1088# endif
1089# endif
1090# ifdef ADJUST_WSTRESS
1091 IF (.not.got_var(idusms)) ldefine=.true.
1092 IF (.not.got_var(idvsms)) ldefine=.true.
1093# endif
1094# if defined ADJUST_STFLUX && defined SOLVE3D
1095 DO itrc=1,nt(ng)
1096 IF (lstflux(itrc,ng)) THEN
1097 IF (.not.got_var(idtsur(itrc))) ldefine=.true.
1098 END IF
1099 END DO
1100# endif
1101
1102
1103
1104 IF (ldefine) THEN
1106 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1107 IF (master) WRITE (stdout,30) trim(ncname)
1108 RETURN
1109 END IF
1110 END IF
1111
1112
1113
1114
1115
1116 define: IF (ldefine) THEN
1117
1118# ifdef ADJUST_BOUNDARY
1119 got_iorj=.false.
1120 got_boundary=.false.
1121 got_obc_adjust=.false.
1122# endif
1123# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1124 got_frc_adjust=.false.
1125# endif
1126 DO i=1,n_dim
1127 SELECT CASE (trim(adjustl(dim_name(i))))
1128 CASE ('xi_rho')
1129 dimids( 1)=dim_id(i)
1130 CASE ('xi_u')
1131 dimids( 2)=dim_id(i)
1132 CASE ('xi_v')
1133 dimids( 3)=dim_id(i)
1134 CASE ('eta_rho')
1135 dimids( 5)=dim_id(i)
1136 CASE ('eta_u')
1137 dimids( 6)=dim_id(i)
1138 CASE ('eta_v')
1139 dimids( 7)=dim_id(i)
1140# ifdef SOLVE3D
1141 CASE ('s_rho')
1142 dimids( 9)=dim_id(i)
1143 CASE ('s_w')
1144 dimids(10)=dim_id(i)
1145# endif
1146# ifdef ADJUST_BOUNDARY
1147 CASE ('boundary')
1148 dimids(14)=dim_id(i)
1149 got_boundary=.true.
1150 CASE ('IorJ')
1151 iorjdim=dim_id(i)
1152 got_iorj=.true.
1153# endif
1154# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1155 CASE ('frc_adjust')
1156 frecdim=dim_id(i)
1157 frecsize=dim_size(i)
1158 got_frc_adjust=.true.
1159# endif
1160# ifdef ADJUST_BOUNDARY
1161 CASE ('obc_adjust')
1162 brecdim=dim_id(i)
1163 brecsize=dim_size(i)
1164 got_obc_adjust=.true.
1165# endif
1166 END SELECT
1167 END DO
1168
1169 dimids(12)=rec_id
1170# ifdef ADJUST_BOUNDARY
1171 IF (.not.got_boundary) THEN
1172 status=def_dim(ng, inlm, ini(ng)%pioFile, ncname, &
1173 & 'boundary', 4, dimids(14))
1174 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1175 END IF
1176 IF (.not.got_iorj) THEN
1177 status=def_dim(ng, inlm, ini(ng)%pioFile, ncname, &
1178 & 'IorJ', iobounds(ng)%IorJ, iorjdim)
1179 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1180 END IF
1181# endif
1182# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1183 IF (.not.got_frc_adjust) THEN
1184 status=def_dim(ng, inlm, ini(ng)%pioFile, ncname, &
1185 & 'frc_adjust', nfrec(ng), frecdim)
1186 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1187 END IF
1188# endif
1189# ifdef ADJUST_BOUNDARY
1190 IF (.not.got_obc_adjust) THEN
1191 status=def_dim(ng, inlm, ini(ng)%pioFile, ncname, &
1192 & 'obc_adjust', nbrec(ng), brecdim)
1193 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1194 END IF
1195# endif
1196
1197
1198
1199# ifdef ADJUST_BOUNDARY
1200 t2dobc(1)=iorjdim
1201 t2dobc(2)=dimids(14)
1202 t2dobc(3)=brecdim
1203 t2dobc(4)=dimids(12)
1204# ifdef SOLVE3D
1205 t3dobc(1)=iorjdim
1206 t3dobc(2)=dimids( 9)
1207 t3dobc(3)=dimids(14)
1208 t3dobc(4)=brecdim
1209 t3dobc(5)=dimids(12)
1210# endif
1211# endif
1212# ifdef ADJUST_STFLUX
1213 t4dfrc(1)=dimids( 1)
1214 t4dfrc(2)=dimids( 5)
1215 t4dfrc(3)=frecdim
1216 t4dfrc(4)=dimids(12)
1217# endif
1218# ifdef ADJUST_WSTRESS
1219
1220
1221
1222 u4dfrc(1)=dimids( 2)
1223 u4dfrc(2)=dimids( 6)
1224 u4dfrc(3)=frecdim
1225 u4dfrc(4)=dimids(12)
1226# endif
1227# ifdef ADJUST_WSTRESS
1228
1229
1230
1231 v4dfrc(1)=dimids( 3)
1232 v4dfrc(2)=dimids( 7)
1233 v4dfrc(3)=frecdim
1234 v4dfrc(4)=dimids(12)
1235# endif
1236
1237
1238
1239 DO i=1,natt
1240 DO j=1,len(vinfo(1))
1241 vinfo(i)(j:j)=' '
1242 END DO
1243 END DO
1244 DO i=1,6
1245 aval(i)=0.0_r8
1246 END DO
1247
1248
1249
1250
1251
1252
1253
1254# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
1255
1256
1257
1258 IF (.not.got_var(idsbry(isfsur)).and. &
1259 & any(lobc(:,isfsur,ng))) THEN
1260 ifield=idsbry(isfsur)
1261 vinfo( 1)=vname(1,ifield)
1262 vinfo( 2)=vname(2,ifield)
1263 vinfo( 3)=vname(3,ifield)
1264 vinfo(14)=vname(4,ifield)
1265 vinfo(16)=vname(1,idtime)
1266 vinfo(21)=vname(6,ifield)
1267 aval(5)=real(iinfo(1,ifield,ng),r8)
1268 ini(ng)%pioVar(ifield)%dkind=
pio_fout
1269 ini(ng)%pioVar(ifield)%gtype=r2dobc
1270
1271 status=def_var(ng, inlm, ini(ng)%pioFile, &
1272 & ini(ng)%pioVar(ifield)%vd, &
1273 &
pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1274 & setfillval = .false.)
1275 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1276 END IF
1277
1278
1279
1280 IF (.not.got_var(idsbry(isubar)).and. &
1281 & any(lobc(:,isubar,ng))) THEN
1282 ifield=idsbry(isubar)
1283 vinfo( 1)=vname(1,ifield)
1284 vinfo( 2)=vname(2,ifield)
1285 vinfo( 3)=vname(3,ifield)
1286 vinfo(14)=vname(4,ifield)
1287 vinfo(16)=vname(1,idtime)
1288 vinfo(21)=vname(6,ifield)
1289 aval(5)=real(iinfo(1,ifield,ng),r8)
1290 ini(ng)%pioVar(ifield)%dkind=
pio_fout
1291 ini(ng)%pioVar(ifield)%gtype=u2dobc
1292
1293 status=def_var(ng, inlm, ini(ng)%pioFile, &
1294 & ini(ng)%pioVar(ifield)%vd, &
1295 &
pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1296 & setfillval = .false.)
1297 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1298 END IF
1299
1300
1301
1302 IF (.not.got_var(idsbry(isvbar)).and. &
1303 & any(lobc(:,isvbar,ng))) THEN
1304 ifield=idsbry(isvbar)
1305 vinfo( 1)=vname(1,ifield)
1306 vinfo( 2)=vname(2,ifield)
1307 vinfo( 3)=vname(3,ifield)
1308 vinfo(14)=vname(4,ifield)
1309 vinfo(16)=vname(1,idtime)
1310 vinfo(21)=vname(6,ifield)
1311 aval(5)=real(iinfo(1,ifield,ng),r8)
1312 ini(ng)%pioVar(ifield)%dkind=
pio_fout
1313 ini(ng)%pioVar(ifield)%gtype=v2dobc
1314
1315 status=def_var(ng, inlm, ini(ng)%pioFile, &
1316 & ini(ng)%pioVar(ifield)%vd, &
1317 &
pio_fout, 4, t2dobc, aval, vinfo, ncname, &
1318 & setfillval = .false.)
1319 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1320 END IF
1321
1322# ifdef SOLVE3D
1323
1324
1325
1326 IF (.not.got_var(idsbry(isuvel)).and. &
1327 & any(lobc(:,isuvel,ng))) THEN
1328 ifield=idsbry(isuvel)
1329 vinfo( 1)=vname(1,ifield)
1330 vinfo( 2)=vname(2,ifield)
1331 vinfo( 3)=vname(3,ifield)
1332 vinfo(14)=vname(4,ifield)
1333 vinfo(16)=vname(1,idtime)
1334 vinfo(21)=vname(6,ifield)
1335 aval(5)=real(iinfo(1,ifield,ng),r8)
1336 ini(ng)%pioVar(ifield)%dkind=
pio_fout
1337 ini(ng)%pioVar(ifield)%gtype=u3dobc
1338
1339 status=def_var(ng, inlm, ini(ng)%pioFile, &
1340 & ini(ng)%pioVar(ifield)%vd, &
1341 &
pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1342 & setfillval = .false.)
1343 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1344 END IF
1345
1346
1347
1348 IF (.not.got_var(idsbry(isvvel)).and. &
1349 & any(lobc(:,isvvel,ng))) THEN
1350 ifield=idsbry(isvvel)
1351 vinfo( 1)=vname(1,ifield)
1352 vinfo( 2)=vname(2,ifield)
1353 vinfo( 3)=vname(3,ifield)
1354 vinfo(14)=vname(4,ifield)
1355 vinfo(16)=vname(1,idtime)
1356 vinfo(21)=vname(6,ifield)
1357 aval(5)=real(iinfo(1,ifield,ng),r8)
1358 ini(ng)%pioVar(ifield)%dkind=
pio_fout
1359 ini(ng)%pioVar(ifield)%gtype=v3dobc
1360
1361 status=def_var(ng, inlm, ini(ng)%pioFile, &
1362 & ini(ng)%pioVar(ifield)%vd, &
1363 &
pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1364 & setfillval = .false.)
1365 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1366 END IF
1367
1368
1369
1370 DO itrc=1,nt(ng)
1371 IF (.not.got_var(idsbry(istvar(itrc))).and. &
1372 & any(lobc(:,istvar(itrc),ng))) THEN
1373 ifield=idsbry(istvar(itrc))
1374 vinfo( 1)=vname(1,ifield)
1375 vinfo( 2)=vname(2,ifield)
1376 vinfo( 3)=vname(3,ifield)
1377 vinfo(14)=vname(4,ifield)
1378 vinfo(16)=vname(1,idtime)
1379 vinfo(21)=vname(6,ifield)
1380 aval(5)=real(iinfo(1,ifield,ng),r8)
1381 ini(ng)%pioVar(ifield)%dkind=
pio_fout
1382 ini(ng)%pioVar(ifield)%gtype=r3dobc
1383
1384 status=def_var(ng, inlm, ini(ng)%pioFile, &
1385 & ini(ng)%pioVar(ifield)%vd, &
1386 &
pio_fout, 5, t3dobc, aval, vinfo, ncname, &
1387 & setfillval = .false.)
1388 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1389 END IF
1390 END DO
1391# endif
1392# endif
1393# ifdef ADJUST_WSTRESS
1394
1395
1396
1397 IF (.not.got_var(idusms)) THEN
1398 vinfo( 1)=vname(1,idusms)
1399 vinfo( 2)=vname(2,idusms)
1400 vinfo( 3)=vname(3,idusms)
1401# if defined WRITE_WATER && defined MASKING
1402 vinfo(20)='mask_u'
1403# endif
1404 vinfo(22)='coordinates'
1405 aval(5)=real(u2dvar,r8)
1406 ini(ng)%pioVar(idusms)%dkind=
pio_fout
1407 ini(ng)%pioVar(idusms)%gtype=u2dvar
1408
1409 status=def_var(ng, inlm, ini(ng)%pioFile, &
1410 & ini(ng)%pioVar(idusms)%vd, &
1411 &
pio_fout, 4, u4dfrc, aval, vinfo, ncname)
1412 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1413 END IF
1414
1415
1416
1417 IF (.not.got_var(idvsms)) THEN
1418 vinfo( 1)=vname(1,idvsms)
1419 vinfo( 2)=vname(2,idvsms)
1420 vinfo( 3)=vname(3,idvsms)
1421# if defined WRITE_WATER && defined MASKING
1422 vinfo(20)='mask_v'
1423# endif
1424 vinfo(22)='coordinates'
1425 aval(5)=real(v2dvar,r8)
1426 ini(ng)%pioVar(idvsms)%dkind=
pio_fout
1427 ini(ng)%pioVar(idvsms)%gtype=v2dvar
1428
1429 status=def_var(ng, inlm, ini(ng)%pioFile, &
1430 & ini(ng)%pioVar(idvsms)%vd, &
1431 &
pio_fout, 4, v4dfrc, aval, vinfo, ncname)
1432 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1433 END IF
1434# endif
1435
1436# if defined ADJUST_STFLUX && defined SOLVE3D
1437
1438
1439
1440 DO itrc=1,nt(ng)
1441 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
1442 vinfo( 1)=vname(1,idtsur(itrc))
1443 vinfo( 2)=vname(2,idtsur(itrc))
1444 vinfo( 3)=vname(3,idtsur(itrc))
1445 IF (itrc.eq.itemp) THEN
1446 vinfo(11)='upward flux, cooling'
1447 vinfo(12)='downward flux, heating'
1448 ELSE IF (itrc.eq.isalt) THEN
1449 vinfo(11)='upward flux, freshening (net precipitation)'
1450 vinfo(12)='downward flux, salting (net evaporation)'
1451 END IF
1452# if defined WRITE_WATER && defined MASKING
1453 vinfo(20)='mask_rho'
1454# endif
1455 vinfo(22)='coordinates'
1456 aval(5)=real(r2dvar,r8)
1457 ini(ng)%pioVar(idtsur(itrc))%dkind=
pio_fout
1458 ini(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1459
1460 status=def_var(ng, inlm, ini(ng)%pioFile, &
1461 & ini(ng)%pioVar(idtsur(itrc))%vd, &
1462 &
pio_fout, 4, t4dfrc, aval, vinfo, ncname)
1463 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1464 END IF
1465 END DO
1466# endif
1467
1468
1469
1470
1471
1473 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1474
1475 END IF define
1476# endif
1477
1478
1479
1480
1481
1482
1483 IF (.not.ldefini(ng)) THEN
1484 ncname=ini(ng)%name
1485
1486
1487
1488 IF (ini(ng)%pioFile%fh.eq.-1) THEN
1490 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1491 WRITE (stdout,10) trim(ncname)
1492 RETURN
1493 END IF
1494 END IF
1495
1496
1497
1499 & piofile = ini(ng)%pioFile)
1500 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1501
1502
1503
1505 & piofile = ini(ng)%pioFile)
1506 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1507
1508
1509
1510 DO i=1,nv
1511 got_var(i)=.false.
1512 END DO
1513
1514
1515
1516
1517 DO i=1,n_var
1518 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1519 got_var(idtime)=.true.
1520 ini(ng)%pioVar(idtime)%vd=
var_desc(i)
1521 ini(ng)%pioVar(idtime)%dkind=
pio_tout
1522 ini(ng)%pioVar(idtime)%gtype=0
1523 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idfsur))) THEN
1524 got_var(idfsur)=.true.
1525 ini(ng)%pioVar(idfsur)%vd=
var_desc(i)
1526 ini(ng)%pioVar(idfsur)%dkind=
pio_fout
1527 ini(ng)%pioVar(idfsur)%gtype=r2dvar
1528 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubar))) THEN
1529 got_var(idubar)=.true.
1530 ini(ng)%pioVar(idubar)%vd=
var_desc(i)
1531 ini(ng)%pioVar(idubar)%dkind=
pio_fout
1532 ini(ng)%pioVar(idubar)%gtype=u2dvar
1533 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbar))) THEN
1534 got_var(idvbar)=.true.
1535 ini(ng)%pioVar(idvbar)%vd=
var_desc(i)
1536 ini(ng)%pioVar(idvbar)%dkind=
pio_fout
1537 ini(ng)%pioVar(idvbar)%gtype=v2dvar
1538# ifdef ADJUST_BOUNDARY
1539 ELSE IF (trim(var_name(i)).eq. &
1540 & trim(vname(1,idsbry(isfsur)))) THEN
1541 got_var(idsbry(isfsur))=.true.
1542 ini(ng)%pioVar(idsbry(isfsur))%vd=
var_desc(i)
1543 ini(ng)%pioVar(idsbry(isfsur))%dkind=
pio_fout
1544 ini(ng)%pioVar(idsbry(isfsur))%gtype=r2dobc
1545 ELSE IF (trim(var_name(i)).eq. &
1546 & trim(vname(1,idsbry(isubar)))) THEN
1547 got_var(idsbry(isubar))=.true.
1548 ini(ng)%pioVar(idsbry(isubar))%vd=
var_desc(i)
1549 ini(ng)%pioVar(idsbry(isubar))%dkind=
pio_fout
1550 ini(ng)%pioVar(idsbry(isubar))%gtype=u2dobc
1551 ELSE IF (trim(var_name(i)).eq. &
1552 & trim(vname(1,idsbry(isvbar)))) THEN
1553 got_var(idsbry(isvbar))=.true.
1554 ini(ng)%pioVar(idsbry(isvbar))%vd=
var_desc(i)
1555 ini(ng)%pioVar(idsbry(isvbar))%dkind=
pio_fout
1556 ini(ng)%pioVar(idsbry(isvbar))%gtype=v2dobc
1557# endif
1558# ifdef ADJUST_WSTRESS
1559 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idusms))) THEN
1560 got_var(idusms)=.true.
1561 ini(ng)%pioVar(idusms)%vd=
var_desc(i)
1562 ini(ng)%pioVar(idusms)%dkind=
pio_fout
1563 ini(ng)%pioVar(idusms)%gtype=u2dvar
1564 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvsms))) THEN
1565 got_var(idvsms)=.true.
1566 ini(ng)%pioVar(idvsms)%vd=
var_desc(i)
1567 ini(ng)%pioVar(idvsms)%dkind=
pio_fout
1568 ini(ng)%pioVar(idvsms)%gtype=v2dvar
1569# endif
1570# ifdef SOLVE3D
1571 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvel))) THEN
1572 got_var(iduvel)=.true.
1573 ini(ng)%pioVar(iduvel)%vd=
var_desc(i)
1574 ini(ng)%pioVar(iduvel)%dkind=
pio_fout
1575 ini(ng)%pioVar(iduvel)%gtype=u3dvar
1576 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvel))) THEN
1577 got_var(idvvel)=.true.
1578 ini(ng)%pioVar(idvvel)%vd=
var_desc(i)
1579 ini(ng)%pioVar(idvvel)%dkind=
pio_fout
1580 ini(ng)%pioVar(idvvel)%gtype=v3dvar
1581# ifdef ADJUST_BOUNDARY
1582 ELSE IF (trim(var_name(i)).eq. &
1583 & trim(vname(1,idsbry(isuvel)))) THEN
1584 got_var(idsbry(isuvel))=.true.
1585 ini(ng)%pioVar(idsbry(isuvel))%vd=
var_desc(i)
1586 ini(ng)%pioVar(idsbry(isuvel))%dkind=
pio_fout
1587 ini(ng)%pioVar(idsbry(isuvel))%gtype=u3dobc
1588 ELSE IF (trim(var_name(i)).eq. &
1589 & trim(vname(1,idsbry(isvvel)))) THEN
1590 got_var(idsbry(isvvel))=.true.
1591 ini(ng)%pioVar(idsbry(isvvel))%vd=
var_desc(i)
1592 ini(ng)%pioVar(idsbry(isvvel))%dkind=
pio_fout
1593 ini(ng)%pioVar(idsbry(isvvel))%gtype=v3dobc
1594# endif
1595# if defined BVF_MIXING || defined LMD_MIXING || \
1596 defined gls_mixing || defined my25_mixing
1597 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvvis))) THEN
1598 got_var(idvvis)=.true.
1599 ini(ng)%pioVar(idvvis)%vd=
var_desc(i)
1600 ini(ng)%pioVar(idvvis)%dkind=
pio_fout
1601 ini(ng)%pioVar(idvvis)%gtype=w3dvar
1602 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idtdif))) THEN
1603 got_var(idtdif)=.true.
1604 ini(ng)%pioVar(idtdif)%vd=
var_desc(i)
1605 ini(ng)%pioVar(idtdif)%dkind=
pio_fout
1606 ini(ng)%pioVar(idtdif)%gtype=w3dvar
1607 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idsdif))) THEN
1608 got_var(idsdif)=.true.
1609 ini(ng)%pioVar(idsdif)%vd=
var_desc(i)
1610 ini(ng)%pioVar(idsdif)%dkind=
pio_fout
1611 ini(ng)%pioVar(idsdif)%gtype=w3dvar
1612# endif
1613# endif
1614 END IF
1615# ifdef SOLVE3D
1616 DO itrc=1,nt(ng)
1617 IF (trim(var_name(i)).eq.trim(vname(1,idtvar(itrc)))) THEN
1618 got_var(idtvar(itrc))=.true.
1619 ini(ng)%pioTrc(itrc)%vd=
var_desc(i)
1620 ini(ng)%pioTrc(itrc)%dkind=
pio_fout
1621 ini(ng)%pioTrc(itrc)%gtype=r3dvar
1622# ifdef ADJUST_BOUNDARY
1623 ELSE IF (trim(var_name(i)).eq. &
1624 & trim(vname(1,idsbry(istvar(itrc))))) THEN
1625 got_var(idsbry(istvar(itrc)))=.true.
1626 ini(ng)%pioVar(idsbry(istvar(itrc)))%vd=
var_desc(i)
1627 ini(ng)%pioVar(idsbry(istvar(itrc)))%dkind=
pio_fout
1628 ini(ng)%pioVar(idsbry(istvar(itrc)))%gtype=r3dobc
1629# endif
1630# ifdef ADJUST_STFLUX
1631 ELSE IF (trim(var_name(i)).eq. &
1632 & trim(vname(1,idtsur(itrc)))) THEN
1633 got_var(idtsur(itrc))=.true.
1634 ini(ng)%pioVar(idtsur(itrc))%vd=
var_desc(i)
1635 ini(ng)%pioVar(idtsur(itrc))%dkind=
pio_fout
1636 ini(ng)%pioVar(idtsur(itrc))%gtype=r2dvar
1637# endif
1638 END IF
1639 END DO
1640# endif
1641 END DO
1642
1643
1644
1645
1646 IF (.not.got_var(idtime)) THEN
1647 IF (master) WRITE (stdout,40) trim(vname(1,idtime)), &
1648 & trim(ncname)
1649 exit_flag=3
1650 RETURN
1651 END IF
1652 IF (.not.got_var(idfsur)) THEN
1653 IF (master) WRITE (stdout,40) trim(vname(1,idfsur)), &
1654 & trim(ncname)
1655 exit_flag=3
1656 RETURN
1657 END IF
1658 IF (.not.got_var(idubar)) THEN
1659 IF (master) WRITE (stdout,40) trim(vname(1,idubar)), &
1660 & trim(ncname)
1661 exit_flag=3
1662 RETURN
1663 END IF
1664 IF (.not.got_var(idvbar)) THEN
1665 IF (master) WRITE (stdout,40) trim(vname(1,idvbar)), &
1666 & trim(ncname)
1667 exit_flag=3
1668 RETURN
1669 END IF
1670# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
1671 IF (.not.got_var(idsbry(isfsur)).and. &
1672 & any(lobc(:,isfsur,ng))) THEN
1673 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isfsur))), &
1674 & trim(ncname)
1675 exit_flag=3
1676 RETURN
1677 END IF
1678 IF (.not.got_var(idsbry(isubar)).and. &
1679 & any(lobc(:,isubar,ng))) THEN
1680 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isubar))), &
1681 & trim(ncname)
1682 exit_flag=3
1683 RETURN
1684 END IF
1685 IF (.not.got_var(idsbry(isvbar)).and. &
1686 & any(lobc(:,isvbar,ng))) THEN
1687 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isvbar))), &
1688 & trim(ncname)
1689 exit_flag=3
1690 RETURN
1691 END IF
1692# endif
1693# ifdef ADJUST_WSTRESS
1694 IF (.not.got_var(idusms)) THEN
1695 IF (master) WRITE (stdout,40) trim(vname(1,idusms)), &
1696 & trim(ncname)
1697 exit_flag=3
1698 RETURN
1699 END IF
1700 IF (.not.got_var(idvsms)) THEN
1701 IF (master) WRITE (stdout,40) trim(vname(1,idvsms)), &
1702 & trim(ncname)
1703 exit_flag=3
1704 RETURN
1705 END IF
1706# endif
1707# ifdef SOLVE3D
1708 IF (.not.got_var(iduvel)) THEN
1709 IF (master) WRITE (stdout,40) trim(vname(1,iduvel)), &
1710 & trim(ncname)
1711 exit_flag=3
1712 RETURN
1713 END IF
1714 IF (.not.got_var(idvvel)) THEN
1715 IF (master) WRITE (stdout,40) trim(vname(1,idvvel)), &
1716 & trim(ncname)
1717 exit_flag=3
1718 RETURN
1719 END IF
1720# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
1721 IF (.not.got_var(idsbry(isuvel)).and. &
1722 & any(lobc(:,isuvel,ng))) THEN
1723 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isuvel))), &
1724 & trim(ncname)
1725 exit_flag=3
1726 RETURN
1727 END IF
1728 IF (.not.got_var(idsbry(isvvel)).and. &
1729 & any(lobc(:,isvvel,ng))) THEN
1730 IF (master) WRITE (stdout,40) trim(vname(1,idsbry(isvvel))), &
1731 & trim(ncname)
1732 exit_flag=3
1733 RETURN
1734 END IF
1735# endif
1736 DO itrc=1,nt(ng)
1737 IF (.not.got_var(idtvar(itrc))) THEN
1738 IF (master) WRITE (stdout,40) trim(vname(1,idtvar(itrc))), &
1739 & trim(ncname)
1740 exit_flag=3
1741 RETURN
1742 END IF
1743# if defined ADJUST_BOUNDARY && !defined RBL4DVAR_FCT_SENSITIVITY
1744 IF (.not.got_var(idsbry(istvar(itrc))).and. &
1745 & any(lobc(:,istvar(itrc),ng))) THEN
1746 IF (master) WRITE (stdout,40) &
1747 & trim(vname(1,idsbry(istvar(itrc)))), &
1748 & trim(ncname)
1749 exit_flag=3
1750 RETURN
1751 END IF
1752# endif
1753# ifdef ADJUST_STFLUX
1754 IF (.not.got_var(idtsur(itrc)).and.lstflux(itrc,ng)) THEN
1755 IF (master) WRITE (stdout,40) trim(vname(1,idtsur(itrc))), &
1756 & trim(ncname)
1757 exit_flag=3
1758 RETURN
1759 END IF
1760# endif
1761 END DO
1762# endif
1763
1764
1765
1766 ini(ng)%Rindex=rec_size
1767 fcount=ini(ng)%Fcount
1768 ini(ng)%Nrec(fcount)=rec_size
1769 END IF
1770
1771 10 FORMAT (/,' DEF_INI_PIO - unable to open initial NetCDF', &
1772 & ' file: ',a)
1773 20 FORMAT (/,' DEF_INI_PIO - illegal dimensions for variable : ',a, &
1774 & /,16x,'Nvardims = ',i0,', missing dimension: ''',a,'''', &
1775 & /,16x,'in file: ',a, &
1776 & /,16x,'Remove such variable from input file.')
1777 30 FORMAT (/,' DEF_INI_PIO - unable to put in define mode initial', &
1778 & ' NetCDF file: ',a)
1779 40 FORMAT (/,' DEF_INI_pio - unable to find variable: ',a,2x, &
1780 & ' in file: ',a)
1781
1782 RETURN
subroutine, public pio_netcdf_redef(ng, model, ncname, piofile)
integer, parameter pio_fout
type(var_desc_t), dimension(:), pointer var_desc
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)