OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sysfus.F File Reference
#include "implicit_f.inc"
#include "hash_id.inc"
#include "com04_c.inc"
#include "r2r_c.inc"
#include "scr17_c.inc"
#include "scr03_c.inc"

Go to the source code of this file.

Functions/Subroutines

integer function usr2sys (iu, itabm1, mess, id)
integer function usrtos (iu, itabm1)
integer function itabm1_search (iu, itabm1)
integer function usr2sys2 (iu, itabm1, mess, jindex, id)
integer function ulist2s (list, nlist, itabm1, mess, index, id)
subroutine udouble (list, ilist, nlist, mess, ir, rlist)
subroutine udoublex (nlist, ilist, ixx, kxx)
subroutine udoubl2 (index, nlist, mess, list, ilist, ir, rlist)
subroutine newdbl (list, ilist, nlist, tab, errid, status, nom_opt)
subroutine newdbl2 (index, nlist, list, ilist, tab, errid, status, nom_opt)
subroutine vdouble (list, ilist, nlist, mess, ir, rlist)
subroutine vdoubl2 (index, nlist, mess, list, ilist, ir, rlist)
subroutine udouble_wo_title (list, ilist, nlist, mess, ir, rlist)
subroutine udoubl2_wo_title (index, nlist, mess, list, ilist, ir, rlist)
subroutine udouble3 (list, ilist, nlist, mess, mess2, ir, rlist)
subroutine udoubl3 (index, nlist, mess, mess2, list, ilist, ir, rlist)
subroutine udouble_igr (list, nlist, mess, ir, rlist)
subroutine udouble_set (list, nlist, mess, ir, rlist)
subroutine udoubl2_igr (index, nlist, mess, list, ir, rlist)
subroutine udoubl2_set (index, nlist, mess, list, ir, rlist)

Function/Subroutine Documentation

◆ itabm1_search()

integer function itabm1_search ( integer, intent(in) iu,
integer, dimension(2*numnod), intent(in) itabm1 )

Definition at line 309 of file sysfus.F.

310C-----------------------------------------------
311C ROUTINE DESCRIPTION :
312C ===================
313C ITABM1_SEARCH : Return INDEX in ITABM1 for a given User ID
314C Permits to have : * entry in ITABM1
315C Internal NOD_ID with (ITABM1(ENTRY+NUMNOD)
316C * -1 if node was no found
317C-----------------------------------------------
318C DUMMY ARGUMENTS DESCRIPTION:
319C ===================
320C
321C NAME DESCRIPTION
322C
323C IU (INPUT) Node User ID
324C ITABM1(2*NUMNOD) (INPUT) Array for UserID -> Internal NodID Mapping
325C============================================================================
326C-----------------------------------------------
327C I m p l i c i t T y p e s
328C-----------------------------------------------
329#include "implicit_f.inc"
330C-----------------------------------------------
331C D u m m y A r g u m e n t s
332C-----------------------------------------------
333 INTEGER, INTENT(IN) :: IU
334 INTEGER, INTENT(IN) :: ITABM1(2*NUMNOD)
335C-----------------------------------------------
336C C o m m o n B l o c k s
337C-----------------------------------------------
338#include "com04_c.inc"
339C-----------------------------------------------
340C L o c a l V a r i a b l e s
341C-----------------------------------------------
342 INTEGER JINF, JSUP, J
343 jinf=1
344 jsup=numnod
345 j=max(1,numnod/2)
346 10 IF(jsup<=jinf.AND.(iu-itabm1(j))/=0) THEN
347 itabm1_search=-1
348 RETURN
349 ENDIF
350 IF((iu-itabm1(j))==0)THEN
351C >CAS IU=TABM FIN DE LA RECHERCHE
352 itabm1_search=j
353 RETURN
354 ELSE IF (iu-itabm1(j)<0) THEN
355C >CAS IU<TABM
356 jsup=j-1
357 ELSE
358C >CAS IU>TABM
359 jinf=j+1
360 ENDIF
361 j=(jsup+jinf)/2
362 GO TO 10
max
#define max(a, b)
Definition macros.h:21
itabm1_search
integer function itabm1_search(iu, itabm1)
Definition sysfus.F:310

◆ newdbl()

subroutine newdbl ( integer, dimension(ilist,nlist) list,
integer ilist,
integer nlist,
integer, dimension(*) tab,
integer errid,
integer status,
integer, dimension(lnopt1,*) nom_opt )

Definition at line 757 of file sysfus.F.

758C TEST LES N0 DOUBLES SUR DES LISTES D'ID de noeuds ou elt ou ...
759C-----------------------------------------------
760C I m p l i c i t T y p e s
761C-----------------------------------------------
762#include "implicit_f.inc"
763C-----------------------------------------------
764C D u m m y A r g u m e n t s
765C-----------------------------------------------
766#include "scr17_c.inc"
767 INTEGER TAB(*)
768 INTEGER ILIST,NLIST,LIST(ILIST,NLIST),ERRID,STATUS
769 INTEGER NOM_OPT(LNOPT1,*)
770C-----------------------------------------------
771C C o m m o n B l o c k s
772C-----------------------------------------------
773#include "scr03_c.inc"
774C-----------------------------------------------
775C ALLOC FREE
776C-----------------------------------------------
777#if CPP_comp == f90
778 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX
779#else
780 pointer(iindex,index(1))
781 INTEGER INDEX
782#endif
783 IF (invers>=40.AND.nlist>=2)THEN
784#if CPP_comp == f90
785 ALLOCATE(index(3*nlist))
786#else
787 CALL my_alloc(iindex,3*nlist,0)
788#endif
789 CALL newdbl2(index,nlist,list,ilist,tab,errid,status,nom_opt)
790#if CPP_comp == f90
791 DEALLOCATE(index)
792#else
793 CALL my_free(iindex)
794#endif
795 ENDIF
796C
797 RETURN
newdbl2
subroutine newdbl2(index, nlist, list, ilist, tab, errid, status, nom_opt)
Definition sysfus.F:811

◆ newdbl2()

subroutine newdbl2 ( integer, dimension(nlist,3) index,
integer nlist,
integer, dimension(ilist,nlist) list,
integer ilist,
integer, dimension(*) tab,
integer errid,
integer status,
integer, dimension(lnopt1,*) nom_opt )

Definition at line 809 of file sysfus.F.

811 USE message_mod
812 USE names_and_titles_mod , ONLY : nchartitle
813C TEST LES N0 DOUBLES
814C-----------------------------------------------
815C I m p l i c i t T y p e s
816C-----------------------------------------------
817#include "implicit_f.inc"
818C-----------------------------------------------
819C D u m m y A r g u m e n t s
820C-----------------------------------------------
821#include "scr17_c.inc"
822 INTEGER NLIST,ILIST,ERRID,STATUS
823 INTEGER TAB(*), INDEX(NLIST,3),LIST(ILIST,NLIST)
824 INTEGER NOM_OPT(LNOPT1,*)
825C-----------------------------------------------
826C L o c a l V a r i a b l e s
827C-----------------------------------------------
828 INTEGER I, ID,IDM, IWORK(70000),ID1
829 CHARACTER(LEN=NCHARTITLE)::TITR
830C-----------------------
831C TRI DE LIST EN ORDRE CROISSANT
832C-----------------------
833 DO i=1,nlist
834 index(i,3)=list(1,i)
835 ENDDO
836C
837 CALL my_orders(0,iwork,index(1,3),index,nlist,1)
838 id=index(index(1,1),3)
839 DO i=2,nlist
840 idm=id
841 id=index(index(i,1),3)
842 IF(id==idm)THEN
843 IF (status < 0) THEN
844C CAS D ONE WARNING STATUS Negatif
845 status = -1*status
846 CALL ancmsg(msgid=errid,
847 . msgtype=msgwarning,
848 . anmode=status,i1=tab(id))
849 status = -1*status
850 ELSE
851C CAS D UNE ERREUR STATUS Positif
852 id1=nom_opt(1,i)
853 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
854 CALL ancmsg(msgid=errid,
855 . msgtype=msgerror,
856 . anmode=status,i1=id1,c1=titr,i2=tab(id))
857 ENDIF
858 ENDIF
859 ENDDO
860C-----------------------
861 RETURN
id
initmumps id
Definition multiplerhs_example.m:4
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804

◆ udoubl2()

subroutine udoubl2 ( integer, dimension(nlist,3) index,
integer nlist,
character mess,
integer, dimension(ilist,nlist) list,
integer ilist,
integer ir,
rlist )

Definition at line 699 of file sysfus.F.

700 USE message_mod
701C TEST LES N0 DOUBLES
702C-----------------------------------------------
703C I m p l i c i t T y p e s
704C-----------------------------------------------
705#include "implicit_f.inc"
706C-----------------------------------------------
707C D u m m y A r g u m e n t s
708C-----------------------------------------------
709 INTEGER NLIST,ILIST,IR
710 CHARACTER MESS*40
711 INTEGER INDEX(NLIST,3),LIST(ILIST,NLIST)
712 my_real
713 . rlist(ilist,nlist)
714C-----------------------------------------------
715C L o c a l V a r i a b l e s
716C-----------------------------------------------
717 INTEGER I, J,NNOD,NOLD,K,ID,IDM,
718 . IWORK(70000)
719C-----------------------
720C TRI DE LIST EN ORDRE CROISSANT
721C-----------------------
722 IF(ir==1)THEN
723 DO i=1,nlist
724 index(i,3)=nint(rlist(1,i))
725 ENDDO
726 ELSE
727 DO i=1,nlist
728 index(i,3)=list(1,i)
729 ENDDO
730 ENDIF
731C
732 CALL my_orders(0,iwork,index(1,3),index,nlist,1)
733 id=index(index(1,1),3)
734 DO i=2,nlist
735 idm=id
736 id=index(index(i,1),3)
737 IF(id==idm .AND. id/=0)THEN
738 CALL ancmsg(msgid=79,
739 . msgtype=msgerror,
740 . anmode=aninfo,
741 . c1=mess,
742 . i1=id)
743 ENDIF
744 ENDDO
745C-----------------------
746 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ udoubl2_igr()

subroutine udoubl2_igr ( integer, dimension(nlist,3) index,
integer nlist,
character mess,
integer, dimension(nlist) list,
integer ir,
rlist )

Definition at line 1323 of file sysfus.F.

1324 USE message_mod
1325C TEST LES N0 DOUBLES
1326C-----------------------------------------------
1327C I m p l i c i t T y p e s
1328C-----------------------------------------------
1329#include "implicit_f.inc"
1330C-----------------------------------------------
1331C D u m m y A r g u m e n t s
1332C-----------------------------------------------
1333 INTEGER NLIST,IR
1334 CHARACTER MESS*40
1335 INTEGER INDEX(NLIST,3),LIST(NLIST)
1336 my_real
1337 . rlist(nlist)
1338C-----------------------------------------------
1339C L o c a l V a r i a b l e s
1340C-----------------------------------------------
1341 INTEGER I, J,NNOD,NOLD,K,ID,IDM,
1342 . IWORK(70000)
1343C-----------------------
1344C TRI DE LIST EN ORDRE CROISSANT
1345C-----------------------
1346 IF(ir==1)THEN
1347 DO i=1,nlist
1348 index(i,3)=nint(rlist(i))
1349 ENDDO
1350 ELSE
1351 DO i=1,nlist
1352 index(i,3)=list(i)
1353 ENDDO
1354 ENDIF
1355C
1356 CALL my_orders(0,iwork,index(1,3),index,nlist,1)
1357 id=index(index(1,1),3)
1358 DO i=2,nlist
1359 idm=id
1360 id=index(index(i,1),3)
1361 IF(id==idm .AND. id/=0)THEN
1362 CALL ancmsg(msgid=79,
1363 . msgtype=msgerror,
1364 . anmode=aninfo,
1365 . c1=mess,
1366 . i1=id)
1367 ENDIF
1368 ENDDO
1369C-----------------------
1370 RETURN

◆ udoubl2_set()

subroutine udoubl2_set ( integer, dimension(nlist,3) index,
integer nlist,
character mess,
integer, dimension(nlist) list,
integer ir,
rlist )

Definition at line 1381 of file sysfus.F.

1382 USE message_mod
1383C TEST LES N0 DOUBLES
1384C-----------------------------------------------
1385C I m p l i c i t T y p e s
1386C-----------------------------------------------
1387#include "implicit_f.inc"
1388C-----------------------------------------------
1389C D u m m y A r g u m e n t s
1390C-----------------------------------------------
1391 INTEGER NLIST,IR
1392 CHARACTER MESS*40
1393 INTEGER INDEX(NLIST,3),LIST(NLIST)
1394 my_real
1395 . rlist(nlist)
1396C-----------------------------------------------
1397C L o c a l V a r i a b l e s
1398C-----------------------------------------------
1399 INTEGER I, J,NNOD,NOLD,K,ID,IDM,
1400 . IWORK(70000)
1401C-----------------------
1402C TRI DE LIST EN ORDRE CROISSANT
1403C-----------------------
1404 IF(ir==1)THEN
1405 DO i=1,nlist
1406 index(i,3)=nint(rlist(i))
1407 ENDDO
1408 ELSE
1409 DO i=1,nlist
1410 index(i,3)=list(i)
1411 ENDDO
1412 ENDIF
1413C
1414 CALL my_orders(0,iwork,index(1,3),index,nlist,1)
1415 id=index(index(1,1),3)
1416 DO i=2,nlist
1417 idm=id
1418 id=index(index(i,1),3)
1419 IF(id==idm)THEN
1420 CALL ancmsg(msgid=1814,
1421 . msgtype=msgerror,
1422 . anmode=aninfo,
1423 . c1=mess,
1424 . i1=id)
1425 ENDIF
1426 ENDDO
1427C-----------------------
1428 RETURN

◆ udoubl2_wo_title()

subroutine udoubl2_wo_title ( integer, dimension(nlist,3) index,
integer nlist,
character mess,
integer, dimension(ilist,nlist) list,
integer ilist,
integer ir,
rlist )

Definition at line 1042 of file sysfus.F.

1043 USE message_mod
1044C TEST LES N0 DOUBLES
1045C-----------------------------------------------
1046C I m p l i c i t T y p e s
1047C-----------------------------------------------
1048#include "implicit_f.inc"
1049C-----------------------------------------------
1050C D u m m y A r g u m e n t s
1051C-----------------------------------------------
1052 INTEGER NLIST,ILIST,IR
1053 CHARACTER MESS*40
1054 INTEGER INDEX(NLIST,3),LIST(ILIST,NLIST)
1055 my_real
1056 . rlist(ilist,nlist)
1057C-----------------------------------------------
1058C L o c a l V a r i a b l e s
1059C-----------------------------------------------
1060 INTEGER I, J,NNOD,NOLD,K,ID,IDM,IDS,
1061 . IWORK(70000)
1062C-----------------------
1063C TRI DE LIST EN ORDRE CROISSANT
1064C-----------------------
1065 IF(ir==1)THEN
1066 DO i=1,nlist
1067 index(i,3)=nint(rlist(1,i))
1068 ENDDO
1069 ELSE
1070 DO i=1,nlist
1071 index(i,3)=list(1,i)
1072 ENDDO
1073 ENDIF
1074C
1075 CALL my_orders(0,iwork,index(1,3),index,nlist,1)
1076 id=index(index(1,1),3)
1077 DO i=2,nlist
1078 idm=id
1079 id=index(index(i,1),3)
1080 IF(id==idm)THEN
1081 ids=list(1,i)
1082 CALL ancmsg(msgid=1108,
1083 . msgtype=msgerror,
1084 . anmode=aninfo,
1085 . c1=mess,
1086 . i1=id)
1087 ENDIF
1088 ENDDO
1089C-----------------------
1090 RETURN

◆ udoubl3()

subroutine udoubl3 ( integer, dimension(nlist,3) index,
integer nlist,
character mess,
character mess2,
integer, dimension(ilist,nlist) list,
integer ilist,
integer ir,
rlist )

Definition at line 1153 of file sysfus.F.

1154 USE message_mod
1155C TEST LES N0 DOUBLES
1156C-----------------------------------------------
1157C I m p l i c i t T y p e s
1158C-----------------------------------------------
1159#include "implicit_f.inc"
1160C-----------------------------------------------
1161C D u m m y A r g u m e n t s
1162C-----------------------------------------------
1163 INTEGER NLIST,ILIST,IR
1164 CHARACTER MESS*40,MESS2*40
1165 INTEGER INDEX(NLIST,3),LIST(ILIST,NLIST)
1166 my_real
1167 . rlist(ilist,nlist)
1168C-----------------------------------------------
1169C L o c a l V a r i a b l e s
1170C-----------------------------------------------
1171 INTEGER I, J,NNOD,NOLD,K,ID,IDM,IDS,
1172 . IWORK(70000)
1173C-----------------------
1174C TRI DE LIST EN ORDRE CROISSANT
1175C-----------------------
1176 IF(ir==1)THEN
1177 DO i=1,nlist
1178 index(i,3)=nint(rlist(1,i))
1179 ENDDO
1180 ELSE
1181 DO i=1,nlist
1182 index(i,3)=list(1,i)
1183 ENDDO
1184 ENDIF
1185C
1186 CALL my_orders(0,iwork,index(1,3),index,nlist,1)
1187 id=index(index(1,1),3)
1188 DO i=2,nlist
1189 idm=id
1190 id=index(index(i,1),3)
1191 IF(id==idm)THEN
1192 ids=list(2,i)
1193 CALL ancmsg(msgid=1154,
1194 . msgtype=msgerror,
1195 . anmode=aninfo,
1196 . c1=mess,
1197 . i1=ids,
1198 . c2=mess2,
1199 . i2=id)
1200 ENDIF
1201 ENDDO
1202C-----------------------
1203 RETURN

◆ udouble()

subroutine udouble ( integer, dimension(ilist,nlist) list,
integer ilist,
integer nlist,
character mess,
integer ir,
rlist )

Definition at line 588 of file sysfus.F.

589C TEST LES N0 DOUBLES
590C-----------------------------------------------
591C I m p l i c i t T y p e s
592C-----------------------------------------------
593#include "implicit_f.inc"
594C-----------------------------------------------
595C D u m m y A r g u m e n t s
596C-----------------------------------------------
597C remonte la declaration des entiers pour la compile sur Compaq
598 INTEGER ILIST,NLIST,LIST(ILIST,NLIST),IR
599 my_real
600 . rlist(ilist,nlist)
601 CHARACTER MESS*40
602C-----------------------------------------------
603C C o m m o n B l o c k s
604C-----------------------------------------------
605C ALLOC FREE
606C-----------------------------------------------
607#if CPP_comp == f90
608 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX
609#else
610 pointer(iindex,index(1))
611 INTEGER INDEX
612#endif
613C-----------------------------------------------
614C L o c a l V a r i a b l e s
615C-----------------------------------------------
616 INTEGER I
617 IF (nlist>=2)THEN
618#if CPP_comp == f90
619 ALLOCATE(index(3*nlist))
620#else
621 CALL my_alloc(iindex,3*nlist,0)
622#endif
623 CALL udoubl2(index,nlist,mess,list,ilist,ir,rlist)
624#if CPP_comp == f90
625 DEALLOCATE(index)
626#else
627 CALL my_free(iindex)
628#endif
629 ENDIF
630C
631 RETURN
udoubl2
subroutine udoubl2(index, nlist, mess, list, ilist, ir, rlist)
Definition sysfus.F:700

◆ udouble3()

subroutine udouble3 ( integer, dimension(ilist,nlist) list,
integer ilist,
integer nlist,
character mess,
character mess2,
integer ir,
rlist )

Definition at line 1099 of file sysfus.F.

1100C TEST LES N0 DOUBLES
1101C-----------------------------------------------
1102C I m p l i c i t T y p e s
1103C-----------------------------------------------
1104#include "implicit_f.inc"
1105C-----------------------------------------------
1106C D u m m y A r g u m e n t s
1107C-----------------------------------------------
1108C remonte la declaration des entiers pour la compile sur Compaq
1109 INTEGER ILIST,NLIST,LIST(ILIST,NLIST),IR
1110 my_real
1111 . rlist(ilist,nlist)
1112 CHARACTER MESS*40,MESS2*40
1113C-----------------------------------------------
1114C C o m m o n B l o c k s
1115C-----------------------------------------------
1116C ALLOC FREE
1117C-----------------------------------------------
1118#if CPP_comp == f90
1119 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX
1120#else
1121 pointer(iindex,index(1))
1122 INTEGER INDEX
1123#endif
1124C-----------------------------------------------
1125C L o c a l V a r i a b l e s
1126C-----------------------------------------------
1127 INTEGER I
1128 IF (nlist>=2)THEN
1129#if CPP_comp == f90
1130 ALLOCATE(index(3*nlist))
1131#else
1132 CALL my_alloc(iindex,3*nlist,0)
1133#endif
1134 CALL udoubl3(index,nlist,mess,mess2,list,ilist,ir,rlist)
1135#if CPP_comp == f90
1136 DEALLOCATE(index)
1137#else
1138 CALL my_free(iindex)
1139#endif
1140 ENDIF
1141C
1142 RETURN
udoubl3
subroutine udoubl3(index, nlist, mess, mess2, list, ilist, ir, rlist)
Definition sysfus.F:1154

◆ udouble_igr()

subroutine udouble_igr ( integer, dimension(nlist) list,
integer nlist,
character mess,
integer ir,
rlist )

Definition at line 1219 of file sysfus.F.

1220C TEST LES N0 DOUBLES
1221C-----------------------------------------------
1222C I m p l i c i t T y p e s
1223C-----------------------------------------------
1224#include "implicit_f.inc"
1225C-----------------------------------------------
1226C D u m m y A r g u m e n t s
1227C-----------------------------------------------
1228C remonte la declaration des entiers pour la compile sur Compaq
1229 INTEGER NLIST,LIST(NLIST),IR
1230 my_real
1231 . rlist(nlist)
1232 CHARACTER MESS*40
1233C-----------------------------------------------
1234C C o m m o n B l o c k s
1235C-----------------------------------------------
1236C ALLOC FREE
1237C-----------------------------------------------
1238#if CPP_comp == f90
1239 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX
1240#else
1241 pointer(iindex,index(1))
1242 INTEGER INDEX
1243#endif
1244C-----------------------------------------------
1245C L o c a l V a r i a b l e s
1246C-----------------------------------------------
1247 INTEGER I
1248 IF (nlist>=2)THEN
1249#if CPP_comp == f90
1250 ALLOCATE(index(3*nlist))
1251#else
1252 CALL my_alloc(iindex,3*nlist,0)
1253#endif
1254 CALL udoubl2_igr(index,nlist,mess,list,ir,rlist)
1255#if CPP_comp == f90
1256 DEALLOCATE(index)
1257#else
1258 CALL my_free(iindex)
1259#endif
1260 ENDIF
1261C
1262 RETURN
udoubl2_igr
subroutine udoubl2_igr(index, nlist, mess, list, ir, rlist)
Definition sysfus.F:1324

◆ udouble_set()

subroutine udouble_set ( integer, dimension(nlist) list,
integer nlist,
character mess,
integer ir,
rlist )

Definition at line 1269 of file sysfus.F.

1270C TEST LES N0 DOUBLES
1271C-----------------------------------------------
1272C I m p l i c i t T y p e s
1273C-----------------------------------------------
1274#include "implicit_f.inc"
1275C-----------------------------------------------
1276C D u m m y A r g u m e n t s
1277C-----------------------------------------------
1278C remonte la declaration des entiers pour la compile sur Compaq
1279 INTEGER NLIST,LIST(NLIST),IR
1280 my_real
1281 . rlist(nlist)
1282 CHARACTER MESS*40
1283C-----------------------------------------------
1284C C o m m o n B l o c k s
1285C-----------------------------------------------
1286C ALLOC FREE
1287C-----------------------------------------------
1288#if CPP_comp == f90
1289 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX
1290#else
1291 pointer(iindex,index(1))
1292 INTEGER INDEX
1293#endif
1294C-----------------------------------------------
1295C L o c a l V a r i a b l e s
1296C-----------------------------------------------
1297 INTEGER I
1298 IF (nlist>=2)THEN
1299#if CPP_comp == f90
1300 ALLOCATE(index(3*nlist))
1301#else
1302 CALL my_alloc(iindex,3*nlist,0)
1303#endif
1304 CALL udoubl2_set(index,nlist,mess,list,ir,rlist)
1305#if CPP_comp == f90
1306 DEALLOCATE(index)
1307#else
1308 CALL my_free(iindex)
1309#endif
1310 ENDIF
1311C
1312 RETURN
udoubl2_set
subroutine udoubl2_set(index, nlist, mess, list, ir, rlist)
Definition sysfus.F:1382

◆ udouble_wo_title()

subroutine udouble_wo_title ( integer, dimension(ilist,nlist) list,
integer ilist,
integer nlist,
character mess,
integer ir,
rlist )

Definition at line 988 of file sysfus.F.

989C TEST LES N0 DOUBLES
990C-----------------------------------------------
991C I m p l i c i t T y p e s
992C-----------------------------------------------
993#include "implicit_f.inc"
994C-----------------------------------------------
995C D u m m y A r g u m e n t s
996C-----------------------------------------------
997C remonte la declaration des entiers pour la compile sur Compaq
998 INTEGER ILIST,NLIST,LIST(ILIST,NLIST),IR
999 my_real
1000 . rlist(ilist,nlist)
1001 CHARACTER MESS*40
1002C-----------------------------------------------
1003C C o m m o n B l o c k s
1004C-----------------------------------------------
1005C ALLOC FREE
1006C-----------------------------------------------
1007#if CPP_comp == f90
1008 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX
1009#else
1010 pointer(iindex,index(1))
1011 INTEGER INDEX
1012#endif
1013C-----------------------------------------------
1014C L o c a l V a r i a b l e s
1015C-----------------------------------------------
1016 INTEGER I
1017 IF (nlist>=2)THEN
1018#if CPP_comp == f90
1019 ALLOCATE(index(3*nlist))
1020#else
1021 CALL my_alloc(iindex,3*nlist,0)
1022#endif
1023 CALL udoubl2_wo_title(index,nlist,mess,list,ilist,ir,rlist)
1024#if CPP_comp == f90
1025 DEALLOCATE(index)
1026#else
1027 CALL my_free(iindex)
1028#endif
1029 ENDIF
1030C
1031 RETURN
udoubl2_wo_title
subroutine udoubl2_wo_title(index, nlist, mess, list, ilist, ir, rlist)
Definition sysfus.F:1043

◆ udoublex()

subroutine udoublex ( integer nlist,
integer ilist,
integer, dimension(*) ixx,
integer, dimension(ilist,*) kxx )

Definition at line 638 of file sysfus.F.

639C TEST LES N0 DOUBLES
640C-----------------------------------------------
641C I m p l i c i t T y p e s
642C-----------------------------------------------
643#include "implicit_f.inc"
644C-----------------------------------------------
645C D u m m y A r g u m e n t s
646C-----------------------------------------------
647C remonte la declaration des entiers pour la compile sur Compaq
648 INTEGER ILIST,NLIST,IXX(*),N,KXX(ILIST,*),
649 . IAD,nnod
650
651C-----------------------------------------------
652C C o m m o n B l o c k s
653C-----------------------------------------------
654C ALLOC FREE
655C-----------------------------------------------
656#if CPP_comp == f90
657 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX
658#else
659 pointer(iindex,index(1))
660 INTEGER INDEX
661#endif
662C-----------------------------------------------
663C L o c a l V a r i a b l e s
664C-----------------------------------------------
665 INTEGER I
666 IF (nlist>=2)THEN
667#if CPP_comp == f90
668 ALLOCATE(index(3*nlist))
669#else
670 CALL my_alloc(iindex,3*nlist,0)
671#endif
672 DO n=1,nlist
673 iad=kxx(4,n)
674 print*,'UBOUBLE X - MULTIBRIN NUM :',n
675 nnod = kxx(3,n)
676 do i=1,nnod
677 print*,'IXX:', ixx(iad+i-1)
678 enddo
679 enddo
680#if CPP_comp == f90
681 DEALLOCATE(index)
682#else
683 CALL my_free(iindex)
684#endif
685 ENDIF
686C
687 RETURN

◆ ulist2s()

integer function ulist2s ( integer, dimension(*) list,
integer nlist,
integer, dimension(*) itabm1,
character mess,
integer, dimension(*) index,
integer id )

Definition at line 464 of file sysfus.F.

465C-----------------------------------------------
466C M o d u l e s
467C-----------------------------------------------
468 USE message_mod
469C-----------------------------------------------
470C D e s c r i p t i o n
471C-----------------------------------------------
472C Function is sending back Internal node identifiers from a list of user node identifiers
473C-----------------------------------------------
474C I m p l i c i t T y p e s
475C-----------------------------------------------
476#include "implicit_f.inc"
477C-----------------------------------------------
478C D u m m y A r g u m e n t s
479C-----------------------------------------------
480 INTEGER LIST(*),NLIST,ID
481 CHARACTER MESS*40
482 INTEGER ITABM1(*),INDEX(*)
483C ITABM1(1:NUMNOD) NO USER TRIE
484C ITABM1(1+NUMNOD:2*NUMNOD) INDEX NUMBER
485C ITABM1(NUMNOD+J) INTERNAL NODE IDENTIFIER IN ITABM1(J)
486C-----------------------------------------------
487C C o m m o n B l o c k s
488C-----------------------------------------------
489#include "com04_c.inc"
490C-----------------------------------------------
491C L o c a l V a r i a b l e s
492C-----------------------------------------------
493 INTEGER I, J,NNOD,NOLD,K, IWORK(70000)
494C-----------------------------------------------
495C E x t e r n a l F u n c t i o n s
496C-----------------------------------------------
497 INTEGER USR2SYS2
498C-----------------------
499C SORT (ASCENDING ORDER)
500C-----------------------
501 CALL my_orders(0,iwork,list,index,nlist,1)
502 DO i=1,nlist
503 index(nlist+i) = list(index(i))
504 ENDDO
505 k=1
506 nold = index(nlist+1)
507 DO i=1,nlist
508 IF(nold/=index(nlist+i))k=k+1
509 list(k) = index(nlist+i)
510 nold = index(nlist+i)
511 ENDDO
512 nnod=k
513C-----------------------
514C SEARCH NODES FROM LIST() IN ITABM1()
515C ALGO < NLIST+NUMNOD
516C-----------------------
517C I=1
518C J=1
519C USR2SYS2 is sending back J, index in ITABM1 array such as LIST(1)=ITABM1(J)
520C cursor is then directly positioned on the correct address in ITABM1
521 list(1)=usr2sys2(list(1),itabm1,mess,j,id)
522 IF(j==0)THEN
523 ! in case of error, node does not exist
524 ulist2s=0
525 ELSE
526C
527 DO i=2,nnod
528 DO WHILE(list(i)>itabm1(j).AND.j<numnod)
529 j=j+1
530 ENDDO
531 IF(list(i)==itabm1(j))THEN
532 list(i)=itabm1(numnod+j)
533 ELSE
534 CALL ancmsg(msgid=78,
535 . msgtype=msgerror,
536 . anmode=aninfo,
537 . c1=mess,
538 . i1=id,
539 . i2=list(i))
540 ulist2s=i-1
541 RETURN
542 ENDIF
543 ENDDO
544C
545 ulist2s=nnod
546
547 ENDIF
548
549 RETURN
ulist2s
integer function ulist2s(list, nlist, itabm1, mess, index, id)
Definition sysfus.F:465
usr2sys2
integer function usr2sys2(iu, itabm1, mess, jindex, id)
Definition sysfus.F:374

◆ usr2sys()

integer function usr2sys ( integer iu,
integer, dimension(*) itabm1,
character mess,
integer id )

Definition at line 159 of file sysfus.F.

160 USE message_mod
161C FONCTION DONNE N0 SYSTEME DU NOEUD USER IU
162C-----------------------------------------------
163C I m p l i c i t T y p e s
164C-----------------------------------------------
165#include "implicit_f.inc"
166C-----------------------------------------------
167C D u m m y A r g u m e n t s
168C-----------------------------------------------
169 INTEGER IU,ID
170 CHARACTER MESS*40
171 INTEGER ITABM1(*)
172 LOGICAL :: HAS_SEARCH_FAILED
173C-----------------------------------------------
174C E x t e r n a l F u n c t i o n s
175C-----------------------------------------------
176 INTEGER R2R_SYS
177C-----------------------------------------------
178C C o m m o n B l o c k s
179C-----------------------------------------------
180#include "hash_id.inc"
181#include "com04_c.inc"
182#include "r2r_c.inc"
183C-----------------------------------------------
184C L o c a l V a r i a b l e s
185C-----------------------------------------------
186 INTEGER JINF, JSUP, J, NN
187
188 j = -1
189 CALL c_hash_find(h_node,iu,j)
190 usr2sys = j
191
192 IF(nsubdom > 0 .OR. usr2sys < 0 .OR. itabm1(max(1,j)) /= iu) THEN
193 jinf=1
194 jsup=numnod
195 j=max(1,numnod/2)
196 has_search_failed=.false.
197 10 IF(j == 0)THEN
198 has_search_failed = .true.
199 ELSE
200 IF(jsup <= jinf .AND. (iu-itabm1(j)) /= 0) has_search_failed=.true.
201 ENDIF
202 IF(has_search_failed) THEN
203 IF ((nsubdom>0).AND.(flg_split==1)) THEN
204C----- -------Multidomaines -> On check dans la liste des noeuds suprimes-----
205 nn=r2r_sys(iu,itabm1,mess)
206 IF (nn==0) THEN
207 CALL ancmsg(msgid=895,
208 . msgtype=msgerror,
209 . anmode=anstop,
210 . i1=iu)
211 ENDIF
212C----- ------------------------------------------------------
213 ELSE
214 CALL ancmsg(msgid=78,
215 . msgtype=msgerror,
216 . anmode=aninfo,
217 . c1=mess,
218 . i1=id,
219 . i2=iu)
220 usr2sys=0
221 ENDIF
222 RETURN
223 ENDIF
224 IF((iu-itabm1(j))==0)THEN
225C >CAS IU=TABM FIN DE LA RECHERCHE
226 usr2sys=itabm1(j+numnod)
227 RETURN
228 ELSE IF (iu-itabm1(j)<0) THEN
229C >CAS IU<TABM
230 jsup=j-1
231 ELSE
232C >CAS IU>TABM
233 jinf=j+1
234 ENDIF
235 j=(jsup+jinf)/2
236 GO TO 10
237 ENDIF
c_hash_find
void c_hash_find(int *map, int *key, int *val)
Definition c_hash_table.cpp:129
r2r_sys
integer function r2r_sys(iu, itabm1, mess)
Definition routines_r2r.F:67
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160

◆ usr2sys2()

integer function usr2sys2 ( integer iu,
integer, dimension(*) itabm1,
character mess,
integer jindex,
integer, intent(in) id )

Definition at line 373 of file sysfus.F.

374C-----------------------------------------------
375C M o d u l e s
376C-----------------------------------------------
377 USE message_mod
378C-----------------------------------------------
379C D e s c r i p t i o n
380C-----------------------------------------------
381C SAME AS USR2SYS, SENDING INDEX JINDEX CORRESPONDING TO
382C INTERNAL IDENTIFIER OF USER NODE IDENTIFIER IU
383C-----------------------------------------------
384C I m p l i c i t T y p e s
385C-----------------------------------------------
386#include "implicit_f.inc"
387C-----------------------------------------------
388C D u m m y A r g u m e n t s
389C-----------------------------------------------
390 INTEGER IU, JINDEX
391 CHARACTER MESS*40
392 INTEGER ITABM1(*)
393 INTEGER,INTENT(IN) :: ID
394C-----------------------------------------------
395C E x t e r n a l F u n c t i o n s
396C-----------------------------------------------
397 INTEGER R2R_SYS
398C-----------------------------------------------
399C C o m m o n B l o c k s
400C-----------------------------------------------
401#include "com04_c.inc"
402#include "r2r_c.inc"
403C-----------------------------------------------
404C L o c a l V a r i a b l e s
405C-----------------------------------------------
406 INTEGER JINF, JSUP, J, NN
407 jindex=0
408 jinf=1
409 jsup=numnod
410 j=max(1,numnod/2)
411 10 IF(jsup<=jinf.AND.(iu-itabm1(j))/=0) THEN
412 IF (nsubdom>0) THEN
413C------------Multidomaines -> checking in list of deleted nodes-----
414 nn=r2r_sys(iu,itabm1,mess)
415 IF (nn==0) THEN
416 CALL ancmsg(msgid=895,
417 . msgtype=msgerror,
418 . anmode=anstop,
419 . i1=iu)
420 ENDIF
421C-----------------------------------------------------------
422 ELSE
423 CALL ancmsg(msgid=78,
424 . msgtype=msgerror,
425 . anmode=aninfo,
426 . c1=mess,
427 . i1=id,
428 . i2=iu)
429 usr2sys2=0
430 ENDIF
431 RETURN
432 ENDIF
433 IF((iu-itabm1(j))==0)THEN
434C >CASE IU=TABM : ENDING THE SEARCH ALGORITHM
435 jindex=j
436 usr2sys2=itabm1(j+numnod)
437 RETURN
438 ELSE IF (iu-itabm1(j)<0) THEN
439C >CASE IU<TABM
440 jsup=j-1
441 ELSE
442C >CASE IU>TABM
443 jinf=j+1
444 ENDIF
445 j=(jsup+jinf)/2
446 GO TO 10

◆ usrtos()

integer function usrtos ( integer iu,
integer, dimension(*) itabm1 )

Definition at line 254 of file sysfus.F.

255C IDENTIQUE A USR2SYS, SANS GENERER D'ERREUR
256C FONCTION DONNE N0 SYSTEME DU NOEUD USER IU
257C-----------------------------------------------
258C I m p l i c i t T y p e s
259C-----------------------------------------------
260#include "implicit_f.inc"
261C-----------------------------------------------
262C D u m m y A r g u m e n t s
263C-----------------------------------------------
264 INTEGER IU
265 INTEGER ITABM1(*)
266C-----------------------------------------------
267C C o m m o n B l o c k s
268C-----------------------------------------------
269#include "com04_c.inc"
270C-----------------------------------------------
271C L o c a l V a r i a b l e s
272C-----------------------------------------------
273 INTEGER JINF, JSUP, J
274 ! Out of bounds at startup - no need to iterate
275 IF(iu < itabm1(1) .OR. iu > itabm1(numnod) ) THEN
276 usrtos=0
277 RETURN
278 ENDIF
279
280 jinf=1
281 jsup=numnod
282 j=max(1,numnod/2)
283 10 IF(j < 1 .OR. j>numnod)THEN ! out of bounds
284 usrtos=0
285 RETURN
286 ENDIF
287 IF(jsup<=jinf.AND.(iu-itabm1(j))/=0) THEN ! not found
288 usrtos=0
289 RETURN
290 ENDIF
291 IF((iu-itabm1(j))==0)THEN
292C >CAS IU=TABM FIN DE LA RECHERCHE
293 usrtos=itabm1(j+numnod)
294 RETURN
295 ELSE IF (iu-itabm1(j)<0) THEN
296C >CAS IU<TABM
297 jsup=j-1
298 ELSE
299C >CAS IU>TABM
300 jinf=j+1
301 ENDIF
302 j=(jsup+jinf)/2
303 GO TO 10
usrtos
integer function usrtos(iu, itabm1)
Definition sysfus.F:255

◆ vdoubl2()

subroutine vdoubl2 ( integer, dimension(nlist,3) index,
integer nlist,
character mess,
integer, dimension(ilist,nlist) list,
integer ilist,
integer ir,
rlist )

Definition at line 932 of file sysfus.F.

933 USE message_mod
934C TEST LES N0 DOUBLES , TOUS FORMATS, ERREUR
935C-----------------------------------------------
936C I m p l i c i t T y p e s
937C-----------------------------------------------
938#include "implicit_f.inc"
939C-----------------------------------------------
940C D u m m y A r g u m e n t s
941C-----------------------------------------------
942 INTEGER NLIST,ILIST,IR
943 CHARACTER MESS*40
944 INTEGER INDEX(NLIST,3),LIST(ILIST,NLIST)
945 my_real
946 . rlist(ilist,nlist)
947C-----------------------------------------------
948C L o c a l V a r i a b l e s
949C-----------------------------------------------
950 INTEGER I, J,NNOD,NOLD,K,ID,IDM,
951 . IWORK(70000)
952C-----------------------
953C TRI DE LIST EN ORDRE CROISSANT
954C-----------------------
955 IF(ir==1)THEN
956 DO i=1,nlist
957 index(i,3)=nint(rlist(1,i))
958 ENDDO
959 ELSE
960 DO i=1,nlist
961 index(i,3)=list(1,i)
962 ENDDO
963 ENDIF
964C
965 CALL my_orders(0,iwork,index(1,3),index,nlist,1)
966 id=index(index(1,1),3)
967 DO i=2,nlist
968 idm=id
969 id=index(index(i,1),3)
970 IF(id==idm .AND. id/=0)THEN
971 CALL ancmsg(msgid=79,
972 . msgtype=msgerror,
973 . anmode=aninfo,
974 . c1=mess,
975 . i1=id)
976 ENDIF
977 ENDDO
978C-----------------------
979 RETURN

◆ vdouble()

subroutine vdouble ( integer, dimension(ilist,nlist) list,
integer ilist,
integer nlist,
character mess,
integer ir,
rlist )

Definition at line 883 of file sysfus.F.

884C TEST LES N0 DOUBLES , TOUS FORMATS, ERREUR
885C-----------------------------------------------
886C I m p l i c i t T y p e s
887C-----------------------------------------------
888#include "implicit_f.inc"
889C-----------------------------------------------
890C D u m m y A r g u m e n t s
891C-----------------------------------------------
892 INTEGER ILIST,NLIST,LIST(ILIST,NLIST),IR
893 my_real
894 . rlist(ilist,nlist)
895 CHARACTER MESS*40
896C-----------------------------------------------
897C ALLOC FREE
898C-----------------------------------------------
899#if CPP_comp == f90
900 INTEGER, DIMENSION(:),ALLOCATABLE :: INDEX
901#else
902 pointer(iindex,index(1))
903 INTEGER INDEX
904#endif
905C-----------------------------------------------
906C L o c a l V a r i a b l e s
907C-----------------------------------------------
908 INTEGER I
909#if CPP_comp == f90
910 ALLOCATE(index(3*nlist))
911#else
912 CALL my_alloc(iindex,3*nlist,0)
913#endif
914 CALL vdoubl2(index,nlist,mess,list,ilist,ir,rlist)
915#if CPP_comp == f90
916 DEALLOCATE(index)
917#else
918 CALL my_free(iindex)
919#endif
920C
921 RETURN
vdoubl2
subroutine vdoubl2(index, nlist, mess, list, ilist, ir, rlist)
Definition sysfus.F:933