OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
upgrade_multimp.F File Reference
#include "implicit_f.inc"
#include "tabsiz_c.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "scr03_c.inc"
#include "scr05_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine upgrade_multimp (ni, multimp_parameter, intbuf_tab)
subroutine upgrade_cand_opt (ni, k_stok, intbuf_tab)
subroutine upgrade_lcand_edg (ni, multimp_parameter, intbuf_tab)
subroutine upgrade_lcand_e2s (ni, multimp_parameter, intbuf_tab)

Function/Subroutine Documentation

◆ upgrade_cand_opt()

subroutine upgrade_cand_opt ( integer ni,
integer k_stok,
type(intbuf_struct_) intbuf_tab )

Definition at line 1123 of file upgrade_multimp.F.

1124C-----------------------------------------------
1125C M o d u l e s
1126C-----------------------------------------------
1127 USE restmod
1128 USE intbufdef_mod
1129C-------------------------------------------------------
1130C I m p l i c i t T y p e s
1131C-----------------------------------------------
1132#include "implicit_f.inc"
1133C-----------------------------------------------
1134C C o m m o n B l o c k s
1135C-----------------------------------------------
1136#include "tabsiz_c.inc"
1137#include "param_c.inc"
1138#include "com04_c.inc"
1139#include "scr03_c.inc"
1140#include "scr05_c.inc"
1141C-----------------------------------------------
1142C D u m m y A r g u m e n t s
1143C-----------------------------------------------
1144 INTEGER NI, K_STOK
1145
1146 TYPE(INTBUF_STRUCT_) INTBUF_TAB
1147C-----------------------------------------------
1148C L o c a l V a r i a b l e s
1149C-----------------------------------------------
1150 INTEGER ITY,IFQ,INACTI,MFROT,NSN,NRTM
1151 INTEGER I,OLD_SIZE,NEW_SIZE,MULTIMP,IERR
1152
1153 INTEGER, DIMENSION (:), ALLOCATABLE :: OLD_TAB_I
1154 my_real, DIMENSION (:), ALLOCATABLE :: old_tab_r
1155C======================================================================|
1156 ierr=0
1157
1158 old_size = intbuf_tab%S_CAND_OPT_N
1159 new_size = intbuf_tab%I_STOK(2)+k_stok
1160
1161C Set Global parameters
1162 ity = ipari(npari*(ni-1)+7)
1163 inacti = abs(ipari(npari*(ni-1)+22))
1164 mfrot = ipari(npari*(ni-1)+30)
1165 ifq = ipari(npari*(ni-1)+31)
1166 nsn = ipari(npari*(ni-1)+5)
1167 nrtm = ipari(npari*(ni-1)+4)
1168
1169C=======================================================================
1170 IF(ity == 25)THEN
1171C=======================================================================
1172 ALLOCATE (old_tab_i(4*old_size),stat=ierr)
1173 IF(ierr/=0)GOTO 999
1174 ALLOCATE (old_tab_r(4*old_size),stat=ierr)
1175 IF(ierr/=0)GOTO 999
1176
1177 !-----------!
1178 ! FARM
1179 !-----------!
1180 DO i=1,4*old_size
1181 old_tab_i(i)=intbuf_tab%FARM(i)
1182 ENDDO
1183 DEALLOCATE(intbuf_tab%FARM)
1184 intbuf_tab%S_FARM = 4 * new_size
1185 ALLOCATE(intbuf_tab%FARM(intbuf_tab%S_FARM),stat=ierr)
1186 IF(ierr/=0)GOTO 999
1187 intbuf_tab%FARM(1:intbuf_tab%S_FARM)=0
1188 DO i=1,4*old_size
1189 intbuf_tab%FARM(i)=old_tab_i(i)
1190 END DO
1191
1192 !-----------!
1193 ! CAND_OPT_N
1194 !-----------!
1195 DO i=1,old_size
1196 old_tab_i(i)=intbuf_tab%CAND_OPT_N(i)
1197 ENDDO
1198 DEALLOCATE(intbuf_tab%CAND_OPT_N)
1199 intbuf_tab%S_CAND_OPT_N = new_size
1200 ALLOCATE(intbuf_tab%CAND_OPT_N(intbuf_tab%S_CAND_OPT_N),stat=ierr)
1201 IF(ierr/=0)GOTO 999
1202 intbuf_tab%CAND_OPT_N(1:intbuf_tab%S_CAND_OPT_N)=0
1203 DO i=1,old_size
1204 intbuf_tab%CAND_OPT_N(i) = old_tab_i(i)
1205 ENDDO
1206
1207 !-----------!
1208 ! CAND_OPT_E
1209 !-----------!
1210 DO i=1,old_size
1211 old_tab_i(i)=intbuf_tab%CAND_OPT_E(i)
1212 ENDDO
1213 DEALLOCATE(intbuf_tab%CAND_OPT_E)
1214 intbuf_tab%S_CAND_OPT_E = new_size
1215 ALLOCATE(intbuf_tab%CAND_OPT_E(intbuf_tab%S_CAND_OPT_E),stat=ierr)
1216 IF(ierr/=0)GOTO 999
1217 intbuf_tab%CAND_OPT_E(1:intbuf_tab%S_CAND_OPT_E)=0
1218 DO i=1,old_size
1219 intbuf_tab%CAND_OPT_E(i) = old_tab_i(i)
1220 ENDDO
1221
1222 !-----------!
1223 ! PENM
1224 !-----------!
1225 DO i=1,4*old_size
1226 old_tab_r(i)=intbuf_tab%PENM(i)
1227 ENDDO
1228 DEALLOCATE(intbuf_tab%PENM)
1229 intbuf_tab%S_PENM = 4 * new_size
1230 ALLOCATE(intbuf_tab%PENM(intbuf_tab%S_PENM),stat=ierr)
1231 IF(ierr/=0)GOTO 999
1232 intbuf_tab%PENM(1:intbuf_tab%S_PENM)=zero
1233 DO i=1,4*old_size
1234 intbuf_tab%PENM(i) = old_tab_r(i)
1235 ENDDO
1236
1237 !-----------!
1238 ! DISTM
1239 !-----------!
1240 DO i=1,old_size
1241 old_tab_r(i)=intbuf_tab%DISTM(i)
1242 ENDDO
1243 DEALLOCATE(intbuf_tab%DISTM)
1244 intbuf_tab%S_DISTM = new_size
1245 ALLOCATE(intbuf_tab%DISTM(intbuf_tab%S_DISTM),stat=ierr)
1246 IF(ierr/=0)GOTO 999
1247 intbuf_tab%DISTM(1:intbuf_tab%S_DISTM)=zero
1248 DO i=1,old_size
1249 intbuf_tab%DISTM(i) = old_tab_r(i)
1250 ENDDO
1251
1252 !-----------!
1253 ! LBM
1254 !-----------!
1255 DO i=1,4*old_size
1256 old_tab_r(i)=intbuf_tab%LBM(i)
1257 ENDDO
1258 DEALLOCATE(intbuf_tab%LBM)
1259 intbuf_tab%S_LBM= 4 * new_size
1260 ALLOCATE(intbuf_tab%LBM(intbuf_tab%S_LBM),stat=ierr)
1261 IF(ierr/=0)GOTO 999
1262 intbuf_tab%LBM(1:intbuf_tab%S_LBM)=zero
1263 DO i=1,4*old_size
1264 intbuf_tab%LBM(i) = old_tab_r(i)
1265 ENDDO
1266
1267 !-----------!
1268 ! LCM
1269 !-----------!
1270 DO i=1,4*old_size
1271 old_tab_r(i)=intbuf_tab%LCM(i)
1272 ENDDO
1273 DEALLOCATE(intbuf_tab%LCM)
1274 intbuf_tab%S_LCM = 4 * new_size
1275 ALLOCATE(intbuf_tab%LCM(intbuf_tab%S_LCM),stat=ierr)
1276 IF(ierr/=0)GOTO 999
1277 intbuf_tab%LCM(1:intbuf_tab%S_LCM)=zero
1278 DO i=1,4*old_size
1279 intbuf_tab%LCM(i) = old_tab_r(i)
1280 ENDDO
1281
1282 DEALLOCATE (old_tab_i,old_tab_r)
1283
1284 ENDIF !end all interfaces type
1285
1286c=====================================================================
1287cc print*,'----------- Upgrade MultiMP -----------'
1288cc print*,'INTERFACE Number NI:',NI
1289cc print*,'INTERFACE Type :',ITY
1290cc print*,'NSN - NRTM :',NSN,NRTM
1291cc print*,'NCONT :',NCONT
1292cc print*,'User Number : ',IPARI(NPARI*(NI-1)+15)
1293cc print*,' '
1294cc print*,'OLD MULTIMP:',MULTIMP
1295cc print*,'NEW MULTIMP:',MULTIMP_PARAMETER
1296cc print*,' '
1297cc print*,'OLD SIZE MULTIMP*NCONT =',OLD_SIZE
1298cc print*,'NEW SIZE MULTIMP*NCONT =',NEW_SIZE
1299cc print*,'---------------------------------------'
1300cc call my_flush(6)
1301C=======================================================================
1302 RETURN
1303 999 CONTINUE
1304 CALL arret_message_slid(ity,ipari(npari*(ni-1)+15))
1305
1306 CALL arret(2)
my_real
#define my_real
Definition cppsort.cpp:32
restmod::ipari
integer, dimension(:), allocatable, target ipari
Definition restart_mod.F:60
arret_message_slid
subroutine arret_message_slid(ity, intid)
Definition arret_message.F:73
arret
subroutine arret(nn)
Definition arret.F:87

◆ upgrade_lcand_e2s()

subroutine upgrade_lcand_e2s ( integer ni,
integer multimp_parameter,
type(intbuf_struct_) intbuf_tab )

Definition at line 1522 of file upgrade_multimp.F.

1523C-----------------------------------------------
1524C M o d u l e s
1525C-----------------------------------------------
1526 USE restmod
1527 USE intbufdef_mod
1528C-------------------------------------------------------
1529C I m p l i c i t T y p e s
1530C-----------------------------------------------
1531#include "implicit_f.inc"
1532C-----------------------------------------------
1533C C o m m o n B l o c k s
1534C-----------------------------------------------
1535#include "tabsiz_c.inc"
1536#include "param_c.inc"
1537#include "com04_c.inc"
1538#include "scr03_c.inc"
1539#include "scr05_c.inc"
1540C-----------------------------------------------
1541C D u m m y A r g u m e n t s
1542C-----------------------------------------------
1543 INTEGER NI, MULTIMP_PARAMETER
1544
1545 TYPE(INTBUF_STRUCT_) INTBUF_TAB
1546C-----------------------------------------------
1547C L o c a l V a r i a b l e s
1548C-----------------------------------------------
1549 INTEGER ITY,INACTI,NCONTE
1550 INTEGER I,OLD_SIZE,NEW_SIZE,MULTIMP,IERR,IFQ
1551
1552 INTEGER, DIMENSION (:), ALLOCATABLE :: OLD_TAB_I
1553 my_real, DIMENSION (:), ALLOCATABLE :: old_tab_r
1554C======================================================================|
1555 ierr=0
1556
1557 multimp = ipari(npari*(ni-1)+89)
1558 nconte = ipari(npari*(ni-1)+88)
1559 old_size = multimp * nconte
1560 new_size = multimp_parameter * nconte
1561
1562C Set the new MULTIMP parameter for the given Interface
1563 ipari(npari*(ni-1)+89) = multimp_parameter
1564C Set Global parameters
1565 ity = ipari(npari*(ni-1)+7)
1566 inacti = abs(ipari(npari*(ni-1)+22))
1567 ifq = ipari(npari*(ni-1)+31)
1568C=======================================================================
1569 IF(ity == 25)THEN
1570
1571 ALLOCATE (old_tab_i(old_size),stat=ierr)
1572 IF(ierr/=0)GOTO 999
1573 ALLOCATE (old_tab_r(4*old_size),stat=ierr)
1574 IF(ierr/=0)GOTO 999
1575 !-----------!
1576 ! CANDM_E2S
1577 !-----------!
1578 DO i=1,old_size
1579 old_tab_i(i)=intbuf_tab%CANDM_E2S(i)
1580 ENDDO
1581 DEALLOCATE(intbuf_tab%CANDM_E2S)
1582 intbuf_tab%S_CANDM_E2S = multimp_parameter * nconte
1583 ALLOCATE(intbuf_tab%CANDM_E2S(intbuf_tab%S_CANDM_E2S),stat=ierr)
1584 IF(ierr/=0)GOTO 999
1585 intbuf_tab%CANDM_E2S(1:intbuf_tab%S_CANDM_E2S)=0
1586 DO i=1,old_size
1587 intbuf_tab%CANDM_E2S(i) = old_tab_i(i)
1588 ENDDO
1589
1590 !-----------!
1591 ! CANDS_E2S
1592 !-----------!
1593 DO i=1,old_size
1594 old_tab_i(i)=intbuf_tab%CANDS_E2S(i)
1595 ENDDO
1596 DEALLOCATE(intbuf_tab%CANDS_E2S)
1597 intbuf_tab%S_CANDS_E2S = multimp_parameter * nconte
1598 ALLOCATE(intbuf_tab%CANDS_E2S(intbuf_tab%S_CANDS_E2S),stat=ierr)
1599 IF(ierr/=0)GOTO 999
1600 intbuf_tab%CANDS_E2S(1:intbuf_tab%S_CANDS_E2S)=0
1601 DO i=1,old_size
1602 intbuf_tab%CANDS_E2S(i) = old_tab_i(i)
1603 ENDDO
1604
1605C IF(INACTI == 5) THEN
1606 !-----------!
1607 ! CAND_PS
1608 !-----------!
1609 DO i=1,4*old_size
1610 old_tab_r(i)=intbuf_tab%CAND_PS(i)
1611 ENDDO
1612 DEALLOCATE(intbuf_tab%CAND_PS)
1613 intbuf_tab%S_CAND_PS = 4 * multimp_parameter * nconte
1614 ALLOCATE(intbuf_tab%CAND_PS(intbuf_tab%S_CAND_PS),stat=ierr)
1615 IF(ierr/=0)GOTO 999
1616 intbuf_tab%CAND_PS(1:intbuf_tab%S_CAND_PS)=0
1617 DO i=1,4*old_size
1618 intbuf_tab%CAND_PS(i) = old_tab_r(i)
1619 ENDDO
1620C ENDIF
1621
1622 IF (ifq /= 0)THEN
1623 !-----------!
1624 ! IFPEN_E2S
1625 !-----------!
1626 DO i=1,old_size
1627 old_tab_i(i)=intbuf_tab%IFPEN_E2S(i)
1628 ENDDO
1629 DEALLOCATE(intbuf_tab%IFPEN_E2S)
1630 intbuf_tab%S_IFPEN_E2S = multimp_parameter * nconte
1631 ALLOCATE(intbuf_tab%IFPEN_E2S(intbuf_tab%S_IFPEN_E2S),stat=ierr)
1632 IF(ierr/=0)GOTO 999
1633 intbuf_tab%IFPEN_E2S(1:intbuf_tab%S_IFPEN_E2S)=0
1634 DO i=1,old_size
1635 intbuf_tab%IFPEN_E2S(i) = old_tab_i(i)
1636 ENDDO
1637
1638 !-----------!
1639 ! FTSAVX_E2S
1640 !-----------!
1641 DO i=1,old_size
1642 old_tab_r(i)=intbuf_tab%FTSAVX_E2S(i)
1643 ENDDO
1644 DEALLOCATE(intbuf_tab%FTSAVX_E2S)
1645 intbuf_tab%S_FTSAVX_E2S = 4 * multimp_parameter * nconte
1646 ALLOCATE(intbuf_tab%FTSAVX_E2S(intbuf_tab%S_FTSAVX_E2S),stat=ierr)
1647 IF(ierr/=0)GOTO 999
1648 intbuf_tab%FTSAVX_E2S(1:intbuf_tab%S_FTSAVX_E2S)=0
1649 DO i=1,old_size
1650 intbuf_tab%FTSAVX_E2S(i) = old_tab_r(i)
1651 ENDDO
1652
1653 !-----------!
1654 ! FTSAVY_E2S
1655 !-----------!
1656 DO i=1,old_size
1657 old_tab_r(i)=intbuf_tab%FTSAVY_E2S(i)
1658 ENDDO
1659 DEALLOCATE(intbuf_tab%FTSAVY_E2S)
1660 intbuf_tab%S_FTSAVY_E2S = 4 * multimp_parameter * nconte
1661 ALLOCATE(intbuf_tab%FTSAVY_E2S(intbuf_tab%S_FTSAVY_E2S),stat=ierr)
1662 IF(ierr/=0)GOTO 999
1663 intbuf_tab%FTSAVY_E2S(1:intbuf_tab%S_FTSAVY_E2S)=0
1664 DO i=1,old_size
1665 intbuf_tab%FTSAVY_E2S(i) = old_tab_r(i)
1666 ENDDO
1667
1668 !-----------!
1669 ! FTSAVZ
1670 !-----------!
1671 DO i=1,old_size
1672 old_tab_r(i)=intbuf_tab%FTSAVZ_E2S(i)
1673 ENDDO
1674 DEALLOCATE(intbuf_tab%FTSAVZ_E2S)
1675 intbuf_tab%S_FTSAVZ_E2S = 4 * multimp_parameter * nconte
1676 ALLOCATE(intbuf_tab%FTSAVZ_E2S(intbuf_tab%S_FTSAVZ_E2S),stat=ierr)
1677 IF(ierr/=0)GOTO 999
1678 intbuf_tab%FTSAVZ_E2S(1:intbuf_tab%S_FTSAVZ_E2S)=0
1679 DO i=1,old_size
1680 intbuf_tab%FTSAVZ_E2S(i) = old_tab_r(i)
1681 ENDDO
1682 ENDIF
1683
1684 DEALLOCATE (old_tab_i,old_tab_r)
1685
1686C=======================================================================
1687 ENDIF !end all interfaces type
1688
1689c=====================================================================
1690cc print*,'----------- Upgrade MultiMP -----------'
1691cc print*,'INTERFACE Number NI:',NI
1692cc print*,'INTERFACE Type :',ITY
1693cc print*,'NSN - NRTM :',NSN,NRTM
1694cc print*,'NCONT :',NCONT
1695cc print*,'User Number : ',IPARI(NPARI*(NI-1)+15)
1696cc print*,' '
1697cc print*,'OLD MULTIMP:',MULTIMP
1698cc print*,'NEW MULTIMP:',MULTIMP_PARAMETER
1699cc print*,' '
1700cc print*,'OLD SIZE MULTIMP*NCONT =',OLD_SIZE
1701cc print*,'NEW SIZE MULTIMP*NCONT =',NEW_SIZE
1702cc print*,'---------------------------------------'
1703cc call my_flush(6)
1704C=======================================================================
1705 RETURN
1706 999 CONTINUE
1707 CALL arret_message(ity,ipari(npari*(ni-1)+15),intbuf_tab%VARIABLES(37))
1708
1709 CALL arret(2)
arret_message
subroutine arret_message(ity, intid, ipenmax)
Definition arret_message.F:33

◆ upgrade_lcand_edg()

subroutine upgrade_lcand_edg ( integer ni,
integer multimp_parameter,
type(intbuf_struct_) intbuf_tab )

Definition at line 1320 of file upgrade_multimp.F.

1321C-----------------------------------------------
1322C M o d u l e s
1323C-----------------------------------------------
1324 USE restmod
1325 USE intbufdef_mod
1326C-------------------------------------------------------
1327C I m p l i c i t T y p e s
1328C-----------------------------------------------
1329#include "implicit_f.inc"
1330C-----------------------------------------------
1331C C o m m o n B l o c k s
1332C-----------------------------------------------
1333#include "tabsiz_c.inc"
1334#include "param_c.inc"
1335#include "com04_c.inc"
1336#include "scr03_c.inc"
1337#include "scr05_c.inc"
1338C-----------------------------------------------
1339C D u m m y A r g u m e n t s
1340C-----------------------------------------------
1341 INTEGER NI, MULTIMP_PARAMETER
1342
1343 TYPE(INTBUF_STRUCT_) INTBUF_TAB
1344C-----------------------------------------------
1345C L o c a l V a r i a b l e s
1346C-----------------------------------------------
1347 INTEGER ITY,INACTI,NCONTE
1348 INTEGER I,OLD_SIZE,NEW_SIZE,MULTIMP,IERR,IFQ
1349
1350 INTEGER, DIMENSION (:), ALLOCATABLE :: OLD_TAB_I
1351 my_real, DIMENSION (:), ALLOCATABLE :: old_tab_r
1352C======================================================================|
1353 ierr=0
1354
1355 multimp = ipari(npari*(ni-1)+87)
1356 nconte = ipari(npari*(ni-1)+88)
1357 old_size = multimp * nconte
1358 new_size = multimp_parameter * nconte
1359
1360C Set the new MULTIMP parameter for the given Interface
1361 ipari(npari*(ni-1)+87) = multimp_parameter
1362C Set Global parameters
1363 ity = ipari(npari*(ni-1)+7)
1364 inacti = abs(ipari(npari*(ni-1)+22))
1365 ifq = ipari(npari*(ni-1)+31)
1366C=======================================================================
1367 IF(ity == 25)THEN
1368
1369 ALLOCATE (old_tab_i(old_size),stat=ierr)
1370 IF(ierr/=0)GOTO 999
1371 ALLOCATE (old_tab_r(old_size),stat=ierr)
1372 IF(ierr/=0)GOTO 999
1373 !-----------!
1374 ! CANDM_E2E
1375 !-----------!
1376 DO i=1,old_size
1377 old_tab_i(i)=intbuf_tab%CANDM_E2E(i)
1378 ENDDO
1379 DEALLOCATE(intbuf_tab%CANDM_E2E)
1380 intbuf_tab%S_CANDM_E2E = multimp_parameter * nconte
1381 ALLOCATE(intbuf_tab%CANDM_E2E(intbuf_tab%S_CANDM_E2E),stat=ierr)
1382 IF(ierr/=0)GOTO 999
1383 intbuf_tab%CANDM_E2E(1:intbuf_tab%S_CANDM_E2E)=0
1384 DO i=1,old_size
1385 intbuf_tab%CANDM_E2E(i) = old_tab_i(i)
1386 ENDDO
1387
1388 !-----------!
1389 ! CANDS_E2E
1390 !-----------!
1391 DO i=1,old_size
1392 old_tab_i(i)=intbuf_tab%CANDS_E2E(i)
1393 ENDDO
1394 DEALLOCATE(intbuf_tab%CANDS_E2E)
1395 intbuf_tab%S_CANDS_E2E = multimp_parameter * nconte
1396 ALLOCATE(intbuf_tab%CANDS_E2E(intbuf_tab%S_CANDS_E2E),stat=ierr)
1397 IF(ierr/=0)GOTO 999
1398 intbuf_tab%CANDS_E2E(1:intbuf_tab%S_CANDS_E2E)=0
1399 DO i=1,old_size
1400 intbuf_tab%CANDS_E2E(i) = old_tab_i(i)
1401 ENDDO
1402
1403C IF(INACTI == 5) THEN
1404 !-----------!
1405 ! CAND_P
1406 !-----------!
1407 DO i=1,old_size
1408 old_tab_r(i)=intbuf_tab%CAND_P(i)
1409 ENDDO
1410 DEALLOCATE(intbuf_tab%CAND_P)
1411 intbuf_tab%S_CAND_P = multimp_parameter * nconte
1412 ALLOCATE(intbuf_tab%CAND_P(intbuf_tab%S_CAND_P),stat=ierr)
1413 IF(ierr/=0)GOTO 999
1414 intbuf_tab%CAND_P(1:intbuf_tab%S_CAND_P)=0
1415 DO i=1,old_size
1416 intbuf_tab%CAND_P(i) = old_tab_r(i)
1417 ENDDO
1418C ENDIF
1419
1420 IF (ifq /= 0)THEN
1421 !-----------!
1422 ! IFPEN_E2E
1423 !-----------!
1424 DO i=1,old_size
1425 old_tab_i(i)=intbuf_tab%IFPEN_E(i)
1426 ENDDO
1427 DEALLOCATE(intbuf_tab%IFPEN_E)
1428 intbuf_tab%S_IFPEN_E = multimp_parameter * nconte
1429 ALLOCATE(intbuf_tab%IFPEN_E(intbuf_tab%S_IFPEN_E),stat=ierr)
1430 IF(ierr/=0)GOTO 999
1431 intbuf_tab%IFPEN_E(1:intbuf_tab%S_IFPEN_E)=0
1432 DO i=1,old_size
1433 intbuf_tab%IFPEN_E(i) = old_tab_i(i)
1434 ENDDO
1435
1436 !-----------!
1437 ! FTSAVX_E
1438 !-----------!
1439 DO i=1,old_size
1440 old_tab_r(i)=intbuf_tab%FTSAVX_E(i)
1441 ENDDO
1442 DEALLOCATE(intbuf_tab%FTSAVX_E)
1443 intbuf_tab%S_FTSAVX_E = multimp_parameter * nconte
1444 ALLOCATE(intbuf_tab%FTSAVX_E(intbuf_tab%S_FTSAVX_E),stat=ierr)
1445 IF(ierr/=0)GOTO 999
1446 intbuf_tab%FTSAVX_E(1:intbuf_tab%S_FTSAVX_E)=0
1447 DO i=1,old_size
1448 intbuf_tab%FTSAVX_E(i) = old_tab_r(i)
1449 ENDDO
1450
1451 !-----------!
1452 ! FTSAVY_E
1453 !-----------!
1454 DO i=1,old_size
1455 old_tab_r(i)=intbuf_tab%FTSAVY_E(i)
1456 ENDDO
1457 DEALLOCATE(intbuf_tab%FTSAVY_E)
1458 intbuf_tab%S_FTSAVY_E = multimp_parameter * nconte
1459 ALLOCATE(intbuf_tab%FTSAVY_E(intbuf_tab%S_FTSAVY_E),stat=ierr)
1460 IF(ierr/=0)GOTO 999
1461 intbuf_tab%FTSAVY_E(1:intbuf_tab%S_FTSAVY_E)=0
1462 DO i=1,old_size
1463 intbuf_tab%FTSAVY_E(i) = old_tab_r(i)
1464 ENDDO
1465
1466 !-----------!
1467 ! FTSAVZ_E
1468 !-----------!
1469 DO i=1,old_size
1470 old_tab_r(i)=intbuf_tab%FTSAVZ_E(i)
1471 ENDDO
1472 DEALLOCATE(intbuf_tab%FTSAVZ_E)
1473 intbuf_tab%S_FTSAVZ_E = multimp_parameter * nconte
1474 ALLOCATE(intbuf_tab%FTSAVZ_E(intbuf_tab%S_FTSAVZ_E),stat=ierr)
1475 IF(ierr/=0)GOTO 999
1476 intbuf_tab%FTSAVZ_E(1:intbuf_tab%S_FTSAVZ_E)=0
1477 DO i=1,old_size
1478 intbuf_tab%FTSAVZ_E(i) = old_tab_r(i)
1479 ENDDO
1480 ENDIF
1481
1482
1483 DEALLOCATE (old_tab_i,old_tab_r)
1484
1485C=======================================================================
1486 ENDIF !end all interfaces type
1487
1488c=====================================================================
1489cc print*,'----------- Upgrade MultiMP -----------'
1490cc print*,'INTERFACE Number NI:',NI
1491cc print*,'INTERFACE Type :',ITY
1492cc print*,'NSN - NRTM :',NSN,NRTM
1493cc print*,'NCONT :',NCONT
1494cc print*,'User Number : ',IPARI(NPARI*(NI-1)+15)
1495cc print*,' '
1496cc print*,'OLD MULTIMP:',MULTIMP
1497cc print*,'NEW MULTIMP:',MULTIMP_PARAMETER
1498cc print*,' '
1499cc print*,'OLD SIZE MULTIMP*NCONT =',OLD_SIZE
1500cc print*,'NEW SIZE MULTIMP*NCONT =',NEW_SIZE
1501cc print*,'---------------------------------------'
1502cc call my_flush(6)
1503C=======================================================================
1504 RETURN
1505 999 CONTINUE
1506 CALL arret_message(ity,ipari(npari*(ni-1)+15),intbuf_tab%VARIABLES(37))
1507
1508 CALL arret(2)

◆ upgrade_multimp()

subroutine upgrade_multimp ( integer ni,
integer multimp_parameter,
type(intbuf_struct_) intbuf_tab )

Definition at line 47 of file upgrade_multimp.F.

48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE restmod
52 USE intbufdef_mod
53C-------------------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "tabsiz_c.inc"
61#include "param_c.inc"
62#include "com04_c.inc"
63#include "scr03_c.inc"
64#include "scr05_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER NI, MULTIMP_PARAMETER
69
70 TYPE(INTBUF_STRUCT_) INTBUF_TAB
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER ITY,IFQ,INACTI,MFROT,NCONT,ITIED,
75 . NCONTE,NSN,NRTM,IEDGE1,FLAGREMNODE
76 INTEGER I,OLD_SIZE,NEW_SIZE,MULTIMP,
77 . OLD_SIZE2,NEW_SIZE2,IERR,
78 . OLD_SIZE_OPT, NEW_SIZE_OPT
79
80 INTEGER, DIMENSION (:), ALLOCATABLE :: OLD_TAB_I, OLD_TAB2_I, OLD_TAB3_I
81 my_real, DIMENSION (:), ALLOCATABLE :: old_tab_r, old_tab2_r
82C======================================================================|
83 ierr=0
84
85 multimp = ipari(npari*(ni-1)+23)
86 ncont = ipari(npari*(ni-1)+18)
87 old_size = multimp * ncont
88 new_size = multimp_parameter * ncont
89
90 !use for type20
91 nconte = ncont
92 old_size2 = multimp * nconte
93 new_size2 = multimp_parameter * nconte
94
95C Set the new MULTIMP parameter for the given Interface
96 ipari(npari*(ni-1)+23) = multimp_parameter
97C Set Global parameters
98 ity = ipari(npari*(ni-1)+7)
99 inacti = abs(ipari(npari*(ni-1)+22))
100 mfrot = ipari(npari*(ni-1)+30)
101 ifq = ipari(npari*(ni-1)+31)
102 nsn = ipari(npari*(ni-1)+5)
103 nrtm = ipari(npari*(ni-1)+4)
104 iedge1 = ipari(npari*(ni-1)+58)
105 flagremnode= ipari(npari*(ni-1)+63)
106 itied = ipari(npari*(ni-1)+85)
107
108C=======================================================================
109 IF (ity == 7)THEN
110C=======================================================================
111 ALLOCATE (old_tab_i(old_size),stat=ierr)
112 IF(ierr/=0)GOTO 999
113 ALLOCATE (old_tab_r(old_size),stat=ierr)
114 IF(ierr/=0)GOTO 999
115 IF(itied/=0)THEN
116 ALLOCATE (old_tab2_r(8*old_size),stat=ierr)
117 IF(ierr/=0)GOTO 999
118 ELSE
119 ALLOCATE (old_tab2_r(0),stat=ierr)
120 IF(ierr/=0)GOTO 999
121 END IF
122
123 !-----------!
124 ! CAND_E
125 !-----------!
126 DO i=1,old_size
127 old_tab_i(i)=intbuf_tab%CAND_E(i)
128 ENDDO
129 DEALLOCATE(intbuf_tab%CAND_E)
130 intbuf_tab%S_CAND_E = multimp_parameter * ncont
131 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
132 IF(ierr/=0)GOTO 999
133 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
134 DO i=1,old_size
135 intbuf_tab%CAND_E(i) = old_tab_i(i)
136 ENDDO
137
138 !-----------!
139 ! CAND_N
140 !-----------!
141 DO i=1,old_size
142 old_tab_i(i)=intbuf_tab%CAND_N(i)
143 ENDDO
144 DEALLOCATE(intbuf_tab%CAND_N)
145 intbuf_tab%S_CAND_N = multimp_parameter * ncont
146 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
147 IF(ierr/=0)GOTO 999
148 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
149 DO i=1,old_size
150 intbuf_tab%CAND_N(i) = old_tab_i(i)
151 ENDDO
152
153 IF (ifq /= 0)THEN
154 !-----------!
155 ! IFPEN
156 !-----------!
157 DO i=1,old_size
158 old_tab_i(i)=intbuf_tab%IFPEN(i)
159 ENDDO
160 DEALLOCATE(intbuf_tab%IFPEN)
161 intbuf_tab%S_IFPEN = multimp_parameter * ncont
162 ALLOCATE(intbuf_tab%IFPEN(intbuf_tab%S_IFPEN),stat=ierr)
163 IF(ierr/=0)GOTO 999
164 intbuf_tab%IFPEN(1:intbuf_tab%S_IFPEN)=0
165 DO i=1,old_size
166 intbuf_tab%IFPEN(i) = old_tab_i(i)
167 ENDDO
168
169 !-----------!
170 ! FTSAVX
171 !-----------!
172 DO i=1,old_size
173 old_tab_r(i)=intbuf_tab%FTSAVX(i)
174 ENDDO
175 DEALLOCATE(intbuf_tab%FTSAVX)
176 intbuf_tab%S_FTSAVX = multimp_parameter * ncont
177 ALLOCATE(intbuf_tab%FTSAVX(intbuf_tab%S_FTSAVX),stat=ierr)
178 IF(ierr/=0)GOTO 999
179 intbuf_tab%FTSAVX(1:intbuf_tab%S_FTSAVX)=0
180 DO i=1,old_size
181 intbuf_tab%FTSAVX(i) = old_tab_r(i)
182 ENDDO
183
184 !-----------!
185 ! FTSAVY
186 !-----------!
187 DO i=1,old_size
188 old_tab_r(i)=intbuf_tab%FTSAVY(i)
189 ENDDO
190 DEALLOCATE(intbuf_tab%FTSAVY)
191 intbuf_tab%S_FTSAVY = multimp_parameter * ncont
192 ALLOCATE(intbuf_tab%FTSAVY(intbuf_tab%S_FTSAVY),stat=ierr)
193 IF(ierr/=0)GOTO 999
194 intbuf_tab%FTSAVY(1:intbuf_tab%S_FTSAVY)=0
195 DO i=1,old_size
196 intbuf_tab%FTSAVY(i) = old_tab_r(i)
197 ENDDO
198
199 !-----------!
200 ! FTSAVZ
201 !-----------!
202 DO i=1,old_size
203 old_tab_r(i)=intbuf_tab%FTSAVZ(i)
204 ENDDO
205 DEALLOCATE(intbuf_tab%FTSAVZ)
206 intbuf_tab%S_FTSAVZ = multimp_parameter * ncont
207 ALLOCATE(intbuf_tab%FTSAVZ(intbuf_tab%S_FTSAVZ),stat=ierr)
208 IF(ierr/=0)GOTO 999
209 intbuf_tab%FTSAVZ(1:intbuf_tab%S_FTSAVZ)=0
210 DO i=1,old_size
211 intbuf_tab%FTSAVZ(i) = old_tab_r(i)
212 ENDDO
213 ENDIF
214
215 IF(itied/=0)THEN
216 !-----------!
217 ! CAND_F
218 !-----------!
219 DO i=1,8*old_size
220 old_tab2_r(i)=intbuf_tab%CAND_F(i)
221 ENDDO
222 DEALLOCATE(intbuf_tab%CAND_F)
223 intbuf_tab%S_CAND_F = 8 * multimp_parameter * ncont
224 ALLOCATE(intbuf_tab%CAND_F(intbuf_tab%S_CAND_F),stat=ierr)
225 IF(ierr/=0)GOTO 999
226 intbuf_tab%CAND_F(1:intbuf_tab%S_CAND_F)=0
227 DO i=1,8*old_size
228 intbuf_tab%CAND_F(i) = old_tab2_r(i)
229 ENDDO
230 END IF
231
232 IF(inacti == 5 .OR. inacti == 6 .OR. inacti == 7) THEN
233 !-----------!
234 ! CAND_P
235 !-----------!
236 DO i=1,old_size
237 old_tab_r(i)=intbuf_tab%CAND_P(i)
238 ENDDO
239 DEALLOCATE(intbuf_tab%CAND_P)
240 intbuf_tab%S_CAND_P = multimp_parameter * ncont
241 ALLOCATE(intbuf_tab%CAND_P(intbuf_tab%S_CAND_P),stat=ierr)
242 IF(ierr/=0)GOTO 999
243 intbuf_tab%CAND_P(1:intbuf_tab%S_CAND_P)=0
244 DO i=1,old_size
245 intbuf_tab%CAND_P(i) = old_tab_r(i)
246 ENDDO
247 ENDIF
248
249 DEALLOCATE (old_tab_i,old_tab_r,old_tab2_r)
250
251C=======================================================================
252 ELSEIF(ity == 10)THEN
253C=======================================================================
254 ALLOCATE (old_tab_i(old_size),stat=ierr)
255 IF(ierr/=0)GOTO 999
256 ALLOCATE (old_tab_r(old_size),stat=ierr)
257 IF(ierr/=0)GOTO 999
258 ALLOCATE (old_tab2_r(6*old_size),stat=ierr)
259 IF(ierr/=0)GOTO 999 ! specific CAND_F array
260
261 !-----------!
262 ! CAND_E
263 !-----------!
264 DO i=1,old_size
265 old_tab_i(i)=intbuf_tab%CAND_E(i)
266 ENDDO
267 DEALLOCATE(intbuf_tab%CAND_E)
268 intbuf_tab%S_CAND_E = multimp_parameter * ncont
269 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
270 IF(ierr/=0)GOTO 999
271 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
272 DO i=1,old_size
273 intbuf_tab%CAND_E(i) = old_tab_i(i)
274 ENDDO
275
276 !-----------!
277 ! CAND_N
278 !-----------!
279 DO i=1,old_size
280 old_tab_i(i)=intbuf_tab%CAND_N(i)
281 ENDDO
282 DEALLOCATE(intbuf_tab%CAND_N)
283 intbuf_tab%S_CAND_N = multimp_parameter * ncont
284 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
285 IF(ierr/=0)GOTO 999
286 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
287 DO i=1,old_size
288 intbuf_tab%CAND_N(i) = old_tab_i(i)
289 ENDDO
290
291 !-----------!
292 ! CAND_F
293 !-----------!
294 DO i=1,6*old_size
295 old_tab2_r(i)=intbuf_tab%CAND_F(i)
296 ENDDO
297 DEALLOCATE(intbuf_tab%CAND_F)
298 intbuf_tab%S_CAND_F = 6*multimp_parameter * ncont
299 ALLOCATE(intbuf_tab%CAND_F(intbuf_tab%S_CAND_F),stat=ierr)
300 IF(ierr/=0)GOTO 999
301 intbuf_tab%CAND_F(1:intbuf_tab%S_CAND_F)=0
302 DO i=1,6*old_size
303 intbuf_tab%CAND_F(i) = old_tab2_r(i)
304 ENDDO
305
306 DEALLOCATE (old_tab_i,old_tab_r,old_tab2_r)
307
308C=======================================================================
309 ELSEIF(ity == 11)THEN
310C=======================================================================
311 ALLOCATE (old_tab_i(old_size),stat=ierr)
312 IF(ierr/=0)GOTO 999
313 ALLOCATE (old_tab2_i(2*old_size),stat=ierr)
314 IF(ierr/=0)GOTO 999 !specific CHAIN array (2*MUTIMP*NCONT)
315 ALLOCATE (old_tab_r(old_size),stat=ierr)
316 IF(ierr/=0)GOTO 999
317
318 !-----------!
319 ! CAND_E
320 !-----------!
321 DO i=1,old_size
322 old_tab_i(i)=intbuf_tab%CAND_E(i)
323 ENDDO
324 DEALLOCATE(intbuf_tab%CAND_E)
325 intbuf_tab%S_CAND_E = multimp_parameter * ncont
326 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
327 IF(ierr/=0)GOTO 999
328 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
329 DO i=1,old_size
330 intbuf_tab%CAND_E(i) = old_tab_i(i)
331 ENDDO
332
333 !-----------!
334 ! CAND_N
335 !-----------!
336 DO i=1,old_size
337 old_tab_i(i)=intbuf_tab%CAND_N(i)
338 ENDDO
339 DEALLOCATE(intbuf_tab%CAND_N)
340 intbuf_tab%S_CAND_N = multimp_parameter * ncont
341 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
342 IF(ierr/=0)GOTO 999
343 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
344 DO i=1,old_size
345 intbuf_tab%CAND_N(i) = old_tab_i(i)
346 ENDDO
347
348 !-----------!
349 ! CHAIN
350 !-----------!
351 DO i=1,2*old_size
352 old_tab2_i(i)=intbuf_tab%CHAIN(i)
353 ENDDO
354 DEALLOCATE(intbuf_tab%CHAIN)
355 intbuf_tab%S_CHAIN = 2*multimp_parameter * ncont
356 ALLOCATE(intbuf_tab%CHAIN(intbuf_tab%S_CHAIN),stat=ierr)
357 IF(ierr/=0)GOTO 999
358 intbuf_tab%CHAIN(1:intbuf_tab%S_CHAIN)=0
359 DO i=1,2*old_size
360 intbuf_tab%CHAIN(i) = old_tab2_i(i)
361 ENDDO
362
363 IF (mfrot == 2) THEN
364 !-----------!
365 ! IFPEN
366 !-----------!
367 DO i=1,old_size
368 old_tab_i(i)=intbuf_tab%IFPEN(i)
369 ENDDO
370 DEALLOCATE(intbuf_tab%IFPEN)
371 intbuf_tab%S_IFPEN = multimp_parameter * ncont
372 ALLOCATE(intbuf_tab%IFPEN(intbuf_tab%S_IFPEN),stat=ierr)
373 IF(ierr/=0)GOTO 999
374 intbuf_tab%IFPEN(1:intbuf_tab%S_IFPEN)=0
375 DO i=1,old_size
376 intbuf_tab%IFPEN(i) = old_tab_i(i)
377 ENDDO
378
379 !-----------!
380 ! FTSAVX
381 !-----------!
382 DO i=1,old_size
383 old_tab_r(i)=intbuf_tab%FTSAVX(i)
384 ENDDO
385 DEALLOCATE(intbuf_tab%FTSAVX)
386 intbuf_tab%S_FTSAVX = multimp_parameter * ncont
387 ALLOCATE(intbuf_tab%FTSAVX(intbuf_tab%S_FTSAVX),stat=ierr)
388 IF(ierr/=0)GOTO 999
389 intbuf_tab%FTSAVX(1:intbuf_tab%S_FTSAVX)=0
390 DO i=1,old_size
391 intbuf_tab%FTSAVX(i) = old_tab_r(i)
392 ENDDO
393
394 !-----------!
395 ! FTSAVY
396 !-----------!
397 DO i=1,old_size
398 old_tab_r(i)=intbuf_tab%FTSAVY(i)
399 ENDDO
400 DEALLOCATE(intbuf_tab%FTSAVY)
401 intbuf_tab%S_FTSAVY = multimp_parameter * ncont
402 ALLOCATE(intbuf_tab%FTSAVY(intbuf_tab%S_FTSAVY),stat=ierr)
403 IF(ierr/=0)GOTO 999
404 intbuf_tab%FTSAVY(1:intbuf_tab%S_FTSAVY)=0
405 DO i=1,old_size
406 intbuf_tab%FTSAVY(i) = old_tab_r(i)
407 ENDDO
408
409 !-----------!
410 ! FTSAVZ
411 !-----------!
412 DO i=1,old_size
413 old_tab_r(i)=intbuf_tab%FTSAVZ(i)
414 ENDDO
415 DEALLOCATE(intbuf_tab%FTSAVZ)
416 intbuf_tab%S_FTSAVZ = multimp_parameter * ncont
417 ALLOCATE(intbuf_tab%FTSAVZ(intbuf_tab%S_FTSAVZ),stat=ierr)
418 IF(ierr/=0)GOTO 999
419 intbuf_tab%FTSAVZ(1:intbuf_tab%S_FTSAVZ)=0
420 DO i=1,old_size
421 intbuf_tab%FTSAVZ(i) = old_tab_r(i)
422 ENDDO
423 ENDIF
424
425 DEALLOCATE (old_tab_i,old_tab2_i,old_tab_r)
426
427C=======================================================================
428 ELSEIF(ity == 16)THEN
429C=======================================================================
430 ALLOCATE (old_tab_i(old_size))
431 ALLOCATE (old_tab_r(old_size))
432
433 !-----------!
434 ! CAND_E
435 !-----------!
436 DO i=1,old_size
437 old_tab_i(i)=intbuf_tab%CAND_E(i)
438 ENDDO
439 DEALLOCATE(intbuf_tab%CAND_E)
440 intbuf_tab%S_CAND_E = multimp_parameter * ncont
441 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
442 IF(ierr/=0)GOTO 999
443 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
444 DO i=1,old_size
445 intbuf_tab%CAND_E(i) = old_tab_i(i)
446 ENDDO
447
448 !-----------!
449 ! CAND_N
450 !-----------!
451 DO i=1,old_size
452 old_tab_i(i)=intbuf_tab%CAND_N(i)
453 ENDDO
454 DEALLOCATE(intbuf_tab%CAND_N)
455 intbuf_tab%S_CAND_N = multimp_parameter * ncont
456 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
457 IF(ierr/=0)GOTO 999
458 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
459 DO i=1,old_size
460 intbuf_tab%CAND_N(i) = old_tab_i(i)
461 ENDDO
462
463 DEALLOCATE (old_tab_i,old_tab_r)
464
465C=======================================================================
466 ELSEIF(ity == 17)THEN
467C=======================================================================
468 ALLOCATE (old_tab_i(old_size),stat=ierr)
469 IF(ierr/=0)GOTO 999
470 ALLOCATE (old_tab_r(old_size),stat=ierr)
471 IF(ierr/=0)GOTO 999
472
473 !-----------!
474 ! CAND_E
475 !-----------!
476 DO i=1,old_size
477 old_tab_i(i)=intbuf_tab%CAND_E(i)
478 ENDDO
479 DEALLOCATE(intbuf_tab%CAND_E)
480 intbuf_tab%S_CAND_E = multimp_parameter * ncont
481 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
482 IF(ierr/=0)GOTO 999
483 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
484 DO i=1,old_size
485 intbuf_tab%CAND_E(i) = old_tab_i(i)
486 ENDDO
487
488 !-----------!
489 ! CAND_N
490 !-----------!
491 DO i=1,old_size
492 old_tab_i(i)=intbuf_tab%CAND_N(i)
493 ENDDO
494 DEALLOCATE(intbuf_tab%CAND_N)
495 intbuf_tab%S_CAND_N = multimp_parameter * ncont
496 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
497 IF(ierr/=0)GOTO 999
498 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
499 DO i=1,old_size
500 intbuf_tab%CAND_N(i) = old_tab_i(i)
501 ENDDO
502
503 DEALLOCATE (old_tab_i,old_tab_r)
504
505C=======================================================================
506 ELSEIF(ity == 20)THEN
507C=======================================================================
508 ALLOCATE (old_tab_i(old_size),stat=ierr)
509 IF(ierr/=0)GOTO 999
510 ALLOCATE (old_tab2_i(old_size2),stat=ierr)
511 IF(ierr/=0)GOTO 999 !specific MUTIMP*NCONTE arrays
512 ALLOCATE (old_tab3_i(2*old_size2),stat=ierr)
513 IF(ierr/=0)GOTO 999 !specific CHAIN20 array (2*MUTIMP*NCONTE )
514 ALLOCATE (old_tab_r(old_size),stat=ierr)
515 IF(ierr/=0)GOTO 999
516
517 !-----------!
518 ! CAND_E
519 !-----------!
520 DO i=1,old_size
521 old_tab_i(i)=intbuf_tab%CAND_E(i)
522 ENDDO
523 DEALLOCATE(intbuf_tab%CAND_E)
524 intbuf_tab%S_CAND_E = multimp_parameter * ncont
525 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
526 IF(ierr/=0)GOTO 999
527 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
528 DO i=1,old_size
529 intbuf_tab%CAND_E(i) = old_tab_i(i)
530 ENDDO
531
532 !-----------!
533 ! CAND_N
534 !-----------!
535 DO i=1,old_size
536 old_tab_i(i)=intbuf_tab%CAND_N(i)
537 ENDDO
538 DEALLOCATE(intbuf_tab%CAND_N)
539 intbuf_tab%S_CAND_N = multimp_parameter * ncont
540 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
541 IF(ierr/=0)GOTO 999
542 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
543 DO i=1,old_size
544 intbuf_tab%CAND_N(i) = old_tab_i(i)
545 ENDDO
546
547 !-----------!
548 ! LCAND_N
549 !-----------!
550 DO i=1,old_size2
551 old_tab2_i(i)=intbuf_tab%LCAND_N(i)
552 ENDDO
553 DEALLOCATE(intbuf_tab%LCAND_N)
554 intbuf_tab%S_LCAND_N = multimp_parameter * nconte
555 ALLOCATE(intbuf_tab%LCAND_N(intbuf_tab%S_LCAND_N),stat=ierr)
556 IF(ierr/=0)GOTO 999
557 intbuf_tab%LCAND_N(1:intbuf_tab%S_LCAND_N)=0
558 DO i=1,old_size2
559 intbuf_tab%LCAND_N(i) = old_tab2_i(i)
560 ENDDO
561
562 !-----------!
563 ! LCAND_S
564 !-----------!
565 DO i=1,old_size2
566 old_tab2_i(i)=intbuf_tab%LCAND_S(i)
567 ENDDO
568 DEALLOCATE(intbuf_tab%LCAND_S)
569 intbuf_tab%S_LCAND_S = multimp_parameter * nconte
570 ALLOCATE(intbuf_tab%LCAND_S(intbuf_tab%S_LCAND_S),stat=ierr)
571 IF(ierr/=0)GOTO 999
572 intbuf_tab%LCAND_S(1:intbuf_tab%S_LCAND_S)=0
573 DO i=1,old_size2
574 intbuf_tab%LCAND_S(i) = old_tab2_i(i)
575 ENDDO
576
577 !-----------!
578 ! CHAIN20
579 !-----------!
580 DO i=1,2*old_size2
581 old_tab3_i(i)=intbuf_tab%CHAIN20(i)
582 ENDDO
583 DEALLOCATE(intbuf_tab%CHAIN20)
584 intbuf_tab%S_CHAIN20 = 2*multimp_parameter*nconte
585 ALLOCATE(intbuf_tab%CHAIN20(intbuf_tab%S_CHAIN20),stat=ierr)
586 IF(ierr/=0)GOTO 999
587 intbuf_tab%CHAIN20(1:intbuf_tab%S_CHAIN20)=0
588 DO i=1,2*old_size2
589 intbuf_tab%CHAIN20(i) = old_tab3_i(i)
590 ENDDO
591
592 IF(inacti == 5 .OR. inacti == 6 .OR. inacti == 7) THEN
593 !-----------!
594 ! CAND_P
595 !-----------!
596 DO i=1,old_size
597 old_tab_r(i)=intbuf_tab%CAND_P(i)
598 ENDDO
599 DEALLOCATE(intbuf_tab%CAND_P)
600 intbuf_tab%S_CAND_P = multimp_parameter * ncont
601 ALLOCATE(intbuf_tab%CAND_P(intbuf_tab%S_CAND_P),stat=ierr)
602 IF(ierr/=0)GOTO 999
603 intbuf_tab%CAND_P(1:intbuf_tab%S_CAND_P)=0
604 DO i=1,old_size
605 intbuf_tab%CAND_P(i) = old_tab_r(i)
606 ENDDO
607 ENDIF
608
609 IF (ifq/=0) THEN
610 !-----------!
611 ! IFPEN
612 !-----------!
613 DO i=1,old_size
614 old_tab_i(i)=intbuf_tab%IFPEN(i)
615 ENDDO
616 DEALLOCATE(intbuf_tab%IFPEN)
617 intbuf_tab%S_IFPEN = multimp_parameter * ncont
618 ALLOCATE(intbuf_tab%IFPEN(intbuf_tab%S_IFPEN),stat=ierr)
619 IF(ierr/=0)GOTO 999
620 intbuf_tab%IFPEN(1:intbuf_tab%S_IFPEN)=0
621 DO i=1,old_size
622 intbuf_tab%IFPEN(i) = old_tab_i(i)
623 ENDDO
624
625 !-----------!
626 ! CAND_FX
627 !-----------!
628 DO i=1,old_size
629 old_tab_r(i)=intbuf_tab%CAND_FX(i)
630 ENDDO
631 DEALLOCATE(intbuf_tab%CAND_FX)
632 intbuf_tab%S_CAND_FX = multimp_parameter * ncont
633 ALLOCATE(intbuf_tab%CAND_FX(intbuf_tab%S_CAND_FX),stat=ierr)
634 IF(ierr/=0)GOTO 999
635 intbuf_tab%CAND_FX(1:intbuf_tab%S_CAND_FX)=0
636 DO i=1,old_size
637 intbuf_tab%CAND_FX(i) = old_tab_r(i)
638 ENDDO
639
640 !-----------!
641 ! CAND_FY
642 !-----------!
643 DO i=1,old_size
644 old_tab_r(i)=intbuf_tab%CAND_FY(i)
645 ENDDO
646 DEALLOCATE(intbuf_tab%CAND_FY)
647 intbuf_tab%S_CAND_FY = multimp_parameter * ncont
648 ALLOCATE(intbuf_tab%CAND_FY(intbuf_tab%S_CAND_FY),stat=ierr)
649 IF(ierr/=0)GOTO 999
650 intbuf_tab%CAND_FY(1:intbuf_tab%S_CAND_FY)=0
651 DO i=1,old_size
652 intbuf_tab%CAND_FY(i) = old_tab_r(i)
653 ENDDO
654
655 !-----------!
656 ! CAND_FZ
657 !-----------!
658 DO i=1,old_size
659 old_tab_r(i)=intbuf_tab%CAND_FZ(i)
660 ENDDO
661 DEALLOCATE(intbuf_tab%CAND_FZ)
662 intbuf_tab%S_CAND_FZ = multimp_parameter * ncont
663 ALLOCATE(intbuf_tab%CAND_FZ(intbuf_tab%S_CAND_FZ),stat=ierr)
664 IF(ierr/=0)GOTO 999
665 intbuf_tab%CAND_FZ(1:intbuf_tab%S_CAND_FZ)=0
666 DO i=1,old_size
667 intbuf_tab%CAND_FZ(i) = old_tab_r(i)
668 ENDDO
669 ENDIF
670
671 DEALLOCATE (old_tab_i,old_tab2_i,old_tab3_i,old_tab_r)
672
673C=======================================================================
674 ELSEIF(ity == 21)THEN
675C=======================================================================
676 ALLOCATE (old_tab_i(old_size),stat=ierr)
677 IF(ierr/=0)GOTO 999
678 ALLOCATE (old_tab_r(old_size),stat=ierr)
679 IF(ierr/=0)GOTO 999
680
681 !-----------!
682 ! CAND_E
683 !-----------!
684 DO i=1,old_size
685 old_tab_i(i)=intbuf_tab%CAND_E(i)
686 ENDDO
687 DEALLOCATE(intbuf_tab%CAND_E)
688 intbuf_tab%S_CAND_E = multimp_parameter * ncont
689 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
690 IF(ierr/=0)GOTO 999
691 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
692 DO i=1,old_size
693 intbuf_tab%CAND_E(i) = old_tab_i(i)
694 ENDDO
695
696 !-----------!
697 ! CAND_N
698 !-----------!
699 DO i=1,old_size
700 old_tab_i(i)=intbuf_tab%CAND_N(i)
701 ENDDO
702 DEALLOCATE(intbuf_tab%CAND_N)
703 intbuf_tab%S_CAND_N = multimp_parameter * ncont
704 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
705 IF(ierr/=0)GOTO 999
706 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
707 DO i=1,old_size
708 intbuf_tab%CAND_N(i) = old_tab_i(i)
709 ENDDO
710
711 DEALLOCATE (old_tab_i,old_tab_r)
712
713C=======================================================================
714 ELSEIF(ity == 22)THEN
715C=======================================================================
716 ALLOCATE (old_tab_i(old_size),stat=ierr)
717 IF(ierr/=0)GOTO 999
718 ALLOCATE (old_tab_r(old_size),stat=ierr)
719 IF(ierr/=0)GOTO 999
720
721 !-----------!
722 ! CAND_E
723 !-----------!
724 DO i=1,old_size
725 old_tab_i(i)=intbuf_tab%CAND_E(i)
726 ENDDO
727 DEALLOCATE(intbuf_tab%CAND_E)
728 intbuf_tab%S_CAND_E = multimp_parameter * ncont
729 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
730 IF(ierr/=0)GOTO 999
731 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
732 DO i=1,old_size
733 intbuf_tab%CAND_E(i) = old_tab_i(i)
734 ENDDO
735
736 !-----------!
737 ! CAND_N
738 !-----------!
739 DO i=1,old_size
740 old_tab_i(i)=intbuf_tab%CAND_N(i)
741 ENDDO
742 DEALLOCATE(intbuf_tab%CAND_N)
743 intbuf_tab%S_CAND_N = multimp_parameter * ncont
744 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
745 IF(ierr/=0)GOTO 999
746 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
747 DO i=1,old_size
748 intbuf_tab%CAND_N(i) = old_tab_i(i)
749 ENDDO
750
751 IF (ifq /= 0)THEN
752 !-----------!
753 ! IFPEN
754 !-----------!
755 DO i=1,old_size
756 old_tab_i(i)=intbuf_tab%IFPEN(i)
757 ENDDO
758 DEALLOCATE(intbuf_tab%IFPEN)
759 intbuf_tab%S_IFPEN = multimp_parameter * ncont
760 ALLOCATE(intbuf_tab%IFPEN(intbuf_tab%S_IFPEN),stat=ierr)
761 IF(ierr/=0)GOTO 999
762 intbuf_tab%IFPEN(1:intbuf_tab%S_IFPEN)=0
763 DO i=1,old_size
764 intbuf_tab%IFPEN(i) = old_tab_i(i)
765 ENDDO
766 ENDIF
767
768 DEALLOCATE (old_tab_i,old_tab_r)
769
770C=======================================================================
771 ELSEIF(ity == 23)THEN
772C=======================================================================
773 ALLOCATE (old_tab_i(old_size),stat=ierr)
774 IF(ierr/=0)GOTO 999
775 ALLOCATE (old_tab_r(old_size),stat=ierr)
776 IF(ierr/=0)GOTO 999
777
778 !-----------!
779 ! CAND_E
780 !-----------!
781 DO i=1,old_size
782 old_tab_i(i)=intbuf_tab%CAND_E(i)
783 ENDDO
784 DEALLOCATE(intbuf_tab%CAND_E)
785 intbuf_tab%S_CAND_E = multimp_parameter * ncont
786 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
787 IF(ierr/=0)GOTO 999
788 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
789 DO i=1,old_size
790 intbuf_tab%CAND_E(i) = old_tab_i(i)
791 ENDDO
792
793 !-----------!
794 ! CAND_N
795 !-----------!
796 DO i=1,old_size
797 old_tab_i(i)=intbuf_tab%CAND_N(i)
798 ENDDO
799 DEALLOCATE(intbuf_tab%CAND_N)
800 intbuf_tab%S_CAND_N = multimp_parameter * ncont
801 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
802 IF(ierr/=0)GOTO 999
803 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
804 DO i=1,old_size
805 intbuf_tab%CAND_N(i) = old_tab_i(i)
806 ENDDO
807
808 !-----------!
809 ! IFPEN
810 !-----------!
811 DO i=1,old_size
812 old_tab_i(i)=intbuf_tab%IFPEN(i)
813 ENDDO
814 DEALLOCATE(intbuf_tab%IFPEN)
815 intbuf_tab%S_IFPEN = multimp_parameter * ncont
816 ALLOCATE(intbuf_tab%IFPEN(intbuf_tab%S_IFPEN),stat=ierr)
817 IF(ierr/=0)GOTO 999
818 intbuf_tab%IFPEN(1:intbuf_tab%S_IFPEN)=0
819 DO i=1,old_size
820 intbuf_tab%IFPEN(i) = old_tab_i(i)
821 ENDDO
822
823 !-----------!
824 ! CAND_P
825 !-----------!
826 DO i=1,old_size
827 old_tab_r(i)=intbuf_tab%CAND_P(i)
828 ENDDO
829 DEALLOCATE(intbuf_tab%CAND_P)
830 intbuf_tab%S_CAND_P = multimp_parameter * ncont
831 ALLOCATE(intbuf_tab%CAND_P(intbuf_tab%S_CAND_P),stat=ierr)
832 IF(ierr/=0)GOTO 999
833 intbuf_tab%CAND_P(1:intbuf_tab%S_CAND_P)=0
834 DO i=1,old_size
835 intbuf_tab%CAND_P(i) = old_tab_r(i)
836 ENDDO
837
838 !-----------!
839 ! FTSAVX
840 !-----------!
841 DO i=1,old_size
842 old_tab_r(i)=intbuf_tab%FTSAVX(i)
843 ENDDO
844 DEALLOCATE(intbuf_tab%FTSAVX)
845 intbuf_tab%S_FTSAVX = multimp_parameter * ncont
846 ALLOCATE(intbuf_tab%FTSAVX(intbuf_tab%S_FTSAVX),stat=ierr)
847 IF(ierr/=0)GOTO 999
848 intbuf_tab%FTSAVX(1:intbuf_tab%S_FTSAVX)=0
849 DO i=1,old_size
850 intbuf_tab%FTSAVX(i) = old_tab_r(i)
851 ENDDO
852
853 !-----------!
854 ! FTSAVY
855 !-----------!
856 DO i=1,old_size
857 old_tab_r(i)=intbuf_tab%FTSAVY(i)
858 ENDDO
859 DEALLOCATE(intbuf_tab%FTSAVY)
860 intbuf_tab%S_FTSAVY = multimp_parameter * ncont
861 ALLOCATE(intbuf_tab%FTSAVY(intbuf_tab%S_FTSAVY),stat=ierr)
862 IF(ierr/=0)GOTO 999
863 intbuf_tab%FTSAVY(1:intbuf_tab%S_FTSAVY)=0
864 DO i=1,old_size
865 intbuf_tab%FTSAVY(i) = old_tab_r(i)
866 ENDDO
867
868 !-----------!
869 ! FTSAVZ
870 !-----------!
871 DO i=1,old_size
872 old_tab_r(i)=intbuf_tab%FTSAVZ(i)
873 ENDDO
874 DEALLOCATE(intbuf_tab%FTSAVZ)
875 intbuf_tab%S_FTSAVZ = multimp_parameter * ncont
876 ALLOCATE(intbuf_tab%FTSAVZ(intbuf_tab%S_FTSAVZ),stat=ierr)
877 IF(ierr/=0)GOTO 999
878 intbuf_tab%FTSAVZ(1:intbuf_tab%S_FTSAVZ)=0
879 DO i=1,old_size
880 intbuf_tab%FTSAVZ(i) = old_tab_r(i)
881 ENDDO
882
883
884 DEALLOCATE (old_tab_i,old_tab_r)
885
886C=======================================================================
887 ELSEIF(ity == 24)THEN
888C=======================================================================
889 ALLOCATE (old_tab_i(old_size),stat=ierr)
890 IF(ierr/=0)GOTO 999
891 ALLOCATE (old_tab_r(old_size),stat=ierr)
892 IF(ierr/=0)GOTO 999
893
894 !-----------!
895 ! CAND_E
896 !-----------!
897 DO i=1,old_size
898 old_tab_i(i)=intbuf_tab%CAND_E(i)
899 ENDDO
900 DEALLOCATE(intbuf_tab%CAND_E)
901 intbuf_tab%S_CAND_E = multimp_parameter * ncont
902 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
903 IF(ierr/=0)GOTO 999
904 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
905 DO i=1,old_size
906 intbuf_tab%CAND_E(i) = old_tab_i(i)
907 ENDDO
908
909 !-----------!
910 ! CAND_N
911 !-----------!
912 DO i=1,old_size
913 old_tab_i(i)=intbuf_tab%CAND_N(i)
914 ENDDO
915 DEALLOCATE(intbuf_tab%CAND_N)
916 intbuf_tab%S_CAND_N = multimp_parameter * ncont
917 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
918 IF(ierr/=0)GOTO 999
919 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
920 DO i=1,old_size
921 intbuf_tab%CAND_N(i) = old_tab_i(i)
922 ENDDO
923
924 IF (iedge1 > 0) THEN
925 !-----------!
926 ! CAND_T
927 !-----------!
928 DO i=1,old_size
929 old_tab_i(i)=intbuf_tab%CAND_T(i)
930 ENDDO
931 DEALLOCATE(intbuf_tab%CAND_T)
932 intbuf_tab%S_CAND_T = multimp_parameter * ncont
933 ALLOCATE(intbuf_tab%CAND_T(intbuf_tab%S_CAND_T),stat=ierr)
934 IF(ierr/=0)GOTO 999
935 intbuf_tab%CAND_T(1:intbuf_tab%S_CAND_T)=0
936 DO i=1,old_size
937 intbuf_tab%CAND_T(i) = old_tab_i(i)
938 ENDDO
939 ENDIF
940
941C=======================================================================
942 ELSEIF(ity == 25)THEN
943C=======================================================================
944C
945 old_size_opt=intbuf_tab%S_CAND_OPT_N
946 new_size_opt=max(multimp_parameter * ncont,old_size_opt)
947
948 ALLOCATE (old_tab_i(max(old_size,4*old_size_opt)),stat=ierr)
949 IF(ierr/=0)GOTO 999
950 ALLOCATE (old_tab_r(max(old_size,4*old_size_opt)),stat=ierr)
951 IF(ierr/=0)GOTO 999
952
953 !-----------!
954 ! CAND_E
955 !-----------!
956 DO i=1,old_size
957 old_tab_i(i)=intbuf_tab%CAND_E(i)
958 ENDDO
959 DEALLOCATE(intbuf_tab%CAND_E)
960 intbuf_tab%S_CAND_E = multimp_parameter * ncont
961 ALLOCATE(intbuf_tab%CAND_E(intbuf_tab%S_CAND_E),stat=ierr)
962 IF(ierr/=0)GOTO 999
963 intbuf_tab%CAND_E(1:intbuf_tab%S_CAND_E)=0
964 DO i=1,old_size
965 intbuf_tab%CAND_E(i) = old_tab_i(i)
966 ENDDO
967
968 !-----------!
969 ! CAND_N
970 !-----------!
971 DO i=1,old_size
972 old_tab_i(i)=intbuf_tab%CAND_N(i)
973 ENDDO
974 DEALLOCATE(intbuf_tab%CAND_N)
975 intbuf_tab%S_CAND_N = multimp_parameter * ncont
976 ALLOCATE(intbuf_tab%CAND_N(intbuf_tab%S_CAND_N),stat=ierr)
977 IF(ierr/=0)GOTO 999
978 intbuf_tab%CAND_N(1:intbuf_tab%S_CAND_N)=0
979 DO i=1,old_size
980 intbuf_tab%CAND_N(i) = old_tab_i(i)
981 ENDDO
982
983 !-----------!
984 ! FARM
985 !-----------!
986
987 DO i=1,4*old_size_opt
988 old_tab_i(i)=intbuf_tab%FARM(i)
989 ENDDO
990 DEALLOCATE(intbuf_tab%FARM)
991 intbuf_tab%S_FARM = 4 * new_size_opt
992 ALLOCATE(intbuf_tab%FARM(intbuf_tab%S_FARM),stat=ierr)
993 IF(ierr/=0)GOTO 999
994 DO i=1,4*old_size_opt
995 intbuf_tab%FARM(i) = old_tab_i(i)
996 ENDDO
997
998 !-----------!
999 ! CAND_OPT_N
1000 !-----------!
1001 DO i=1,old_size_opt
1002 old_tab_i(i)=intbuf_tab%CAND_OPT_N(i)
1003 ENDDO
1004 DEALLOCATE(intbuf_tab%CAND_OPT_N)
1005 intbuf_tab%S_CAND_OPT_N = new_size_opt
1006 ALLOCATE(intbuf_tab%CAND_OPT_N(intbuf_tab%S_CAND_OPT_N),stat=ierr)
1007 IF(ierr/=0)GOTO 999
1008 intbuf_tab%CAND_OPT_N(1:intbuf_tab%S_CAND_OPT_N)=0
1009 DO i=1,old_size_opt
1010 intbuf_tab%CAND_OPT_N(i) = old_tab_i(i)
1011 ENDDO
1012
1013 !-----------!
1014 ! CAND_OPT_E
1015 !-----------!
1016 DO i=1,old_size_opt
1017 old_tab_i(i)=intbuf_tab%CAND_OPT_E(i)
1018 ENDDO
1019 DEALLOCATE(intbuf_tab%CAND_OPT_E)
1020 intbuf_tab%S_CAND_OPT_E = new_size_opt
1021 ALLOCATE(intbuf_tab%CAND_OPT_E(intbuf_tab%S_CAND_OPT_E),stat=ierr)
1022 intbuf_tab%CAND_OPT_E(1:intbuf_tab%S_CAND_OPT_E)=0
1023 IF(ierr/=0)GOTO 999
1024 DO i=1,old_size_opt
1025 intbuf_tab%CAND_OPT_E(i) = old_tab_i(i)
1026 ENDDO
1027
1028 !-----------!
1029 ! PENM
1030 !-----------!
1031 DO i=1,4*old_size_opt
1032 old_tab_r(i)=intbuf_tab%PENM(i)
1033 ENDDO
1034 DEALLOCATE(intbuf_tab%PENM)
1035 intbuf_tab%S_PENM = 4 * new_size_opt
1036 ALLOCATE(intbuf_tab%PENM(intbuf_tab%S_PENM),stat=ierr)
1037 intbuf_tab%PENM(1:intbuf_tab%S_PENM)=zero
1038 IF(ierr/=0)GOTO 999
1039 DO i=1,4*old_size_opt
1040 intbuf_tab%PENM(i) = old_tab_r(i)
1041 ENDDO
1042
1043 !-----------!
1044 ! DISTM
1045 !-----------!
1046 DO i=1,old_size_opt
1047 old_tab_r(i)=intbuf_tab%DISTM(i)
1048 ENDDO
1049 DEALLOCATE(intbuf_tab%DISTM)
1050 intbuf_tab%S_DISTM = new_size_opt
1051 ALLOCATE(intbuf_tab%DISTM(intbuf_tab%S_DISTM),stat=ierr)
1052 IF(ierr/=0)GOTO 999
1053 DO i=1,old_size_opt
1054 intbuf_tab%DISTM(i) = old_tab_r(i)
1055 ENDDO
1056
1057 !-----------!
1058 ! LBM
1059 !-----------!
1060 DO i=1,4*old_size_opt
1061 old_tab_r(i)=intbuf_tab%LBM(i)
1062 ENDDO
1063 DEALLOCATE(intbuf_tab%LBM)
1064 intbuf_tab%S_LBM= 4 * new_size_opt
1065 ALLOCATE(intbuf_tab%LBM(intbuf_tab%S_LBM),stat=ierr)
1066 IF(ierr/=0)GOTO 999
1067 DO i=1,4*old_size_opt
1068 intbuf_tab%LBM(i) = old_tab_r(i)
1069 ENDDO
1070
1071 !-----------!
1072 ! LCM
1073 !-----------!
1074 DO i=1,4*old_size_opt
1075 old_tab_r(i)=intbuf_tab%LCM(i)
1076 ENDDO
1077 DEALLOCATE(intbuf_tab%LCM)
1078 intbuf_tab%S_LCM = 4 * new_size_opt
1079 ALLOCATE(intbuf_tab%LCM(intbuf_tab%S_LCM),stat=ierr)
1080 IF(ierr/=0)GOTO 999
1081 DO i=1,4*old_size_opt
1082 intbuf_tab%LCM(i) = old_tab_r(i)
1083 ENDDO
1084
1085 DEALLOCATE (old_tab_i,old_tab_r)
1086
1087 ENDIF !end all interfaces type
1088
1089c=====================================================================
1090cc print*,'----------- Upgrade MultiMP -----------'
1091cc print*,'INTERFACE Number NI:',NI
1092cc print*,'INTERFACE Type :',ITY
1093cc print*,'NSN - NRTM :',NSN,NRTM
1094cc print*,'NCONT :',NCONT
1095cc print*,'User Number : ',IPARI(NPARI*(NI-1)+15)
1096cc print*,' '
1097cc print*,'OLD MULTIMP:',MULTIMP
1098cc print*,'NEW MULTIMP:',MULTIMP_PARAMETER
1099cc print*,' '
1100cc print*,'OLD SIZE MULTIMP*NCONT =',OLD_SIZE
1101cc print*,'NEW SIZE MULTIMP*NCONT =',NEW_SIZE
1102cc print*,'---------------------------------------'
1103cc call my_flush(6)
1104C=======================================================================
1105 RETURN
1106 999 CONTINUE
1107 CALL arret_message(ity,ipari(npari*(ni-1)+15),intbuf_tab%VARIABLES(37))
1108
1109 CALL arret(2)
max
#define max(a, b)
Definition macros.h:21