OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
freform.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fredec0 (id)
subroutine fredec4 (copt)
subroutine fredec5 (copt, id)
subroutine fredec6 (copt, copt2)
integer function nodgrnr5 (igu, igs, ibuf, igrnod, itabm1, mess)
integer function nodgrnr6 (m, igu, igs, ibuf, igrnod, itabm1, mess, id)
integer function grfind (igu, igrnod, mess)
subroutine freerr (it)
subroutine fretitl (titr, iasc, l)
subroutine fretitl2 (titr, iasc, l)
subroutine nextsla
subroutine fredec_2key_id_or_key_id (key2, key3, uid, sub_id)
subroutine fredec_2key_4id_t (key2, id, uid, vers, sub_id, titr)
subroutine fredec_key_3id_t (id, uid, vers, titr)
subroutine fredec_2key_4id (key2, id, uid, vers, sub_id)

Function/Subroutine Documentation

◆ fredec0()

subroutine fredec0 ( integer id)

Definition at line 38 of file freform.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43 USE names_and_titles_mod , ONLY : ncharfield
44 USE format_mod , ONLY : lfield, fmt_i
45 USE reader_old_mod , ONLY : kline
46 USE user_id_mod , ONLY : id_limit
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "scr17_c.inc"
55C-----------------------------------------------
56 INTEGER IOP,ID
57 CHARACTER(LEN=NCHARFIELD) :: MOT1
58 INTEGER I,J1,J2
59C-----------------------------------------------
60C /KEYW/int_id
61C-----------------------------------------------
62 i=2
63 DO WHILE(kline(i:i)/='/')
64 i=i+1
65 IF(i>ncharline)CALL freerr(0)
66 ENDDO
67 i=i+1
68 IF(i>ncharline)CALL freerr(0)
69 j1=i
70 mot1=kline(j1:j1-1+lfield)
71 READ(mot1,err=999,fmt=fmt_i)id
72 IF (id>id_limit%GLOBAL.OR.id<=0) THEN
73 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
74 . i1=id,c1=kline)
75 ENDIF
76C
77 RETURN
78 999 CALL freerr(0)
79 CALL my_exit(2)
my_exit
void my_exit(int *i)
Definition analyse.c:1038
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
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
freerr
subroutine freerr(it)
Definition freform.F:506

◆ fredec4()

subroutine fredec4 ( character(len=ncharfield) copt)

Definition at line 89 of file freform.F.

90C-----------------------------------------------
91C M o d u l e s
92C-----------------------------------------------
93 USE names_and_titles_mod , ONLY : ncharfield, ncharline
94 USE reader_old_mod , ONLY : kline
95C-----------------------------------------------
96C I m p l i c i t T y p e s
97C-----------------------------------------------
98#include "implicit_f.inc"
99C-----------------------------------------------
100C C o m m o n B l o c k s
101C-----------------------------------------------
102#include "scr17_c.inc"
103C
104 CHARACTER(LEN=NCHARFIELD) :: COPT
105C
106 INTEGER I,J1,J2,J
107C-----------------------------------------------
108C /KEYW/int_type/int_id
109C-----------------------------------------------
110 i=2
111 DO WHILE(kline(i:i)/='/')
112 i=i+1
113
114 IF(i>ncharline)CALL freerr(0)
115 ENDDO
116 i=i+1
117
118 IF(i>ncharline)CALL freerr(0)
119 j1=i
120 DO WHILE(kline(i:i)/='/')
121 i=i+1
122 IF(i>ncharline)CALL freerr(0)
123
124 ENDDO
125 j2=i-1
126 copt=kline(j1:j2)
127C
128 RETURN

◆ fredec5()

subroutine fredec5 ( character(len=ncharkey) copt,
integer id )

Definition at line 140 of file freform.F.

141C-----------------------------------------------
142C M o d u l e s
143C-----------------------------------------------
144 USE reader_old_mod , ONLY : kline
145 USE message_mod
146 USE names_and_titles_mod , ONLY : ncharkey, ncharfield,ncharline
147 USE format_mod , ONLY : lfield, fmt_i
148 USE user_id_mod , ONLY : id_limit
149C-----------------------------------------------
150C I m p l i c i t T y p e s
151C-----------------------------------------------
152#include "implicit_f.inc"
153C-----------------------------------------------
154C C o m m o n B l o c k s
155C-----------------------------------------------
156#include "scr17_c.inc"
157C-----------------------------------------------
158 INTEGER ID
159 CHARACTER(LEN=NCHARKEY) :: COPT
160C-----------------------------------------------
161 CHARACTER(LEN=NCHARFIELD) :: MOT1
162 INTEGER I,J1,J2,J
163C-----------------------------------------------
164C /KEYW ou
165C /KEYW/KEYW2/int_id
166C-----------------------------------------------
167 i=2
168
169 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
170 i=i+1
171 ENDDO
172 copt=' '
173 i=i+1
174
175 IF(i>ncharline)RETURN
176 j1=i
177
178 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
179 i=i+1
180 ENDDO
181 j2=i-1
182 copt=kline(j1:j2)
183C
184 id=0
185 i=i+1
186 i=min(i,ncharline)
187 IF(i>ncharline-lfield+1)RETURN
188 j1=i
189 DO WHILE(kline(i:i)/='/')
190 i=i+1
191 IF(i>ncharline)EXIT
192 ENDDO
193 j2=i-1
194
195 j2=min(i-1+lfield,j2)
196 mot1=kline(j1:j2)
197
198 READ(mot1,err=999,fmt=fmt_i)id
199C
200 IF (id>id_limit%GLOBAL.OR.id<=0) THEN
201 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
202 . i1=id,c1=kline)
203 ENDIF
204
205C
206 RETURN
207 999 CALL freerr(0)
208 CALL my_exit(2)
min
#define min(a, b)
Definition macros.h:20
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000

◆ fredec6()

subroutine fredec6 ( character(len=ncharkey) copt,
character(len=ncharkey) copt2 )

Definition at line 217 of file freform.F.

218C-----------------------------------------------
219C M o d u l e s
220C-----------------------------------------------
221 USE names_and_titles_mod , ONLY : ncharkey,ncharline
222 USE reader_old_mod , ONLY : kline
223C-----------------------------------------------
224C I m p l i c i t T y p e s
225C-----------------------------------------------
226#include "implicit_f.inc"
227C-----------------------------------------------
228C C o m m o n B l o c k s
229C-----------------------------------------------
230#include "scr17_c.inc"
231C-----------------------------------------------
232 CHARACTER(LEN=NCHARKEY) :: COPT,COPT2
233C-----------------------------------------------
234 INTEGER I,J1,J2,J
235C-----------------------------------------------
236C /KEYW/KEYW2/KEYW3
237C-----------------------------------------------
238 i=2
239
240 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
241 i=i+1
242 ENDDO
243 copt=' '
244 i=i+1
245
246 IF(i>ncharline)RETURN
247 j1=i
248
249 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
250 i=i+1
251 ENDDO
252 j2=i-1
253 copt=kline(j1:j2)
254C
255 copt2=' '
256 i=i+1
257 i=min(i,ncharline)
258 j1=i
259
260 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
261 i=i+1
262 ENDDO
263
264 IF(i>ncharline)RETURN
265 j2=i-1
266 copt2=kline(j1:j2)
267C
268 RETURN
269 999 CALL freerr(0)
270 CALL my_exit(2)

◆ fredec_2key_4id()

subroutine fredec_2key_4id ( character(len=ncharkey) key2,
integer id,
integer uid,
integer vers,
integer sub_id )

Definition at line 1304 of file freform.F.

1305C-----------------------------------------------
1306C M o d u l e s
1307C-----------------------------------------------
1308 USE message_mod
1309 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
1310 USE format_mod , ONLY : fmt_i
1311 USE reader_old_mod , ONLY : kline
1312 USE user_id_mod , ONLY : id_limit
1313C-----------------------------------------------
1314C I m p l i c i t T y p e s
1315C-----------------------------------------------
1316#include "implicit_f.inc"
1317C-----------------------------------------------
1318C C o m m o n B l o c k s
1319C-----------------------------------------------
1320#include "scr17_c.inc"
1321C-----------------------------------------------
1322 INTEGER ID,UID,VERS,SUB_ID
1323 CHARACTER(LEN=NCHARTITLE) :: TITR
1324 CHARACTER(LEN=NCHARKEY) :: KEY2
1325C-----------------------------------------------
1326 INTEGER I,J1,J2,J
1327 CHARACTER(LEN=NCHARFIELD) :: MOT1
1328C-----------------------------------------------
1329C /KEYW/KEY2/int_id/u_id/VERS
1330C-----------------------------------------------
1331C Pass KEY1
1332 i=2
1333 DO WHILE(kline(i:i)/='/')
1334 i=i+1
1335 IF(i>ncharline)CALL freerr(0)
1336 ENDDO
1337 i=i+1
1338C Read KEY2
1339 j1=i
1340 DO WHILE(kline(i:i)/='/')
1341 i=i+1
1342 IF(i>ncharline)CALL freerr(0)
1343 ENDDO
1344 j2=i-1
1345 key2=kline(j1:j2)
1346 i=i+1
1347C--- read ID
1348 j1=i
1349 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1350 i=i+1
1351 ENDDO
1352 IF (i > ncharline) CALL freerr(0)
1353 j2 = i-1
1354 mot1=kline(j1:j2)
1355 READ(mot1,err=999,fmt=fmt_i)id
1356 IF (id > id_limit%GLOBAL .OR. id <= 0) THEN
1357 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
1358 . i1=id,c1=kline)
1359 ENDIF
1360 i =i+1
1361C--- read UID
1362 j1=i
1363 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1364 i=i+1
1365 ENDDO
1366 IF (i > ncharline) CALL freerr(0)
1367 j2 = i-1
1368 mot1=kline(j1:j2)
1369 READ(mot1,err=999,fmt=fmt_i)uid
1370 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
1371 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
1372 . i1=uid,c1=kline)
1373 ENDIF
1374C--- read VERS
1375 i=i+1
1376 j1=i
1377 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1378 i=i+1
1379 ENDDO
1380 j2=i-1
1381 mot1=kline(j1:j2)
1382 READ(mot1,err=999,fmt=fmt_i) vers
1383C--- read SUB_ID
1384 i=i+1
1385 j1=i
1386 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1387 i=i+1
1388 ENDDO
1389 j2=i-1
1390 mot1=kline(j1:j2)
1391 READ(mot1,err=999,fmt=fmt_i) sub_id
1392C---
1393 RETURN
1394 999 CALL freerr(0)
1395 CALL my_exit(2)
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003

◆ fredec_2key_4id_t()

subroutine fredec_2key_4id_t ( character(len=ncharkey) key2,
integer id,
integer uid,
integer vers,
integer sub_id,
character(len=nchartitle) titr )

Definition at line 1109 of file freform.F.

1110C-----------------------------------------------
1111C M o d u l e s
1112C-----------------------------------------------
1113 USE reader_old_mod , ONLY : kline, irec
1114 USE message_mod
1115 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
1116 USE format_mod , ONLY : fmt_i
1117 USE user_id_mod , ONLY : id_limit
1118C-----------------------------------------------
1119C I m p l i c i t T y p e s
1120C-----------------------------------------------
1121#include "implicit_f.inc"
1122C-----------------------------------------------
1123C C o m m o n B l o c k s
1124C-----------------------------------------------
1125#include "scr17_c.inc"
1126#include "units_c.inc"
1127C-----------------------------------------------
1128 INTEGER ID,UID,VERS,SUB_ID
1129 CHARACTER(LEN=NCHARTITLE) :: TITR
1130 CHARACTER(LEN=NCHARKEY) :: KEY2
1131C-----------------------------------------------
1132 INTEGER I,J1,J2,J
1133 CHARACTER(LEN=NCHARFIELD) :: MOT1
1134C-----------------------------------------------
1135C /KEYW/KEY2/int_id/u_id/VERS
1136C + char_title
1137C-----------------------------------------------
1138C Pass KEY1
1139 i=2
1140 DO WHILE(kline(i:i)/='/')
1141 i=i+1
1142 IF(i>ncharline)CALL freerr(0)
1143 ENDDO
1144 i=i+1
1145C Read KEY2
1146 j1=i
1147 DO WHILE(kline(i:i)/='/')
1148 i=i+1
1149 IF(i>ncharline)CALL freerr(0)
1150 ENDDO
1151 j2=i-1
1152 key2=kline(j1:j2)
1153 i=i+1
1154C--- read ID
1155 j1=i
1156 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1157 i=i+1
1158 ENDDO
1159 IF (i > ncharline) CALL freerr(0)
1160 j2 = i-1
1161 mot1=kline(j1:j2)
1162 READ(mot1,err=999,fmt=fmt_i)id
1163 IF (id > id_limit%GLOBAL .OR. id <= 0) THEN
1164 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,i1=id,c1=kline)
1165 ENDIF
1166 i =i+1
1167C--- read UID
1168 j1=i
1169 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1170 i=i+1
1171 ENDDO
1172 IF (i > ncharline) CALL freerr(0)
1173 j2 = i-1
1174 mot1=kline(j1:j2)
1175 READ(mot1,err=999,fmt=fmt_i)uid
1176 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
1177 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,i1=uid,c1=kline)
1178 ENDIF
1179 i =i+1
1180C--- read VERS
1181 j1=i
1182 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1183 i=i+1
1184 ENDDO
1185 j2 = i-1
1186 mot1=kline(j1:j2)
1187 READ(mot1,err=999,fmt=fmt_i)vers
1188C--- read SUB_ID
1189 i =i+1
1190 j1=i
1191 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1192 i=i+1
1193 ENDDO
1194 j2 = i-1
1195 mot1=kline(j1:j2)
1196 READ(mot1,err=999,fmt=fmt_i)sub_id
1197C--- read TITR
1198 irec=irec+1
1199 READ(iin,rec=irec,err=999,fmt='(A)') titr
1200C---
1201 RETURN
1202 999 CALL freerr(0)
1203 CALL my_exit(2)

◆ fredec_2key_id_or_key_id()

subroutine fredec_2key_id_or_key_id ( character(len=ncharkey) key2,
character(len=ncharkey) key3,
integer uid,
integer sub_id )

Definition at line 887 of file freform.F.

888C-----------------------------------------------
889C M o d u l e s
890C-----------------------------------------------
891 USE message_mod
892 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield, ncharline
893 USE format_mod , ONLY : fmt_i
894 USE reader_old_mod , ONLY : kline
895 USE user_id_mod , ONLY : id_limit
896C-----------------------------------------------
897C I m p l i c i t T y p e s
898C-----------------------------------------------
899#include "implicit_f.inc"
900C-----------------------------------------------
901C C o m m o n B l o c k s
902C-----------------------------------------------
903#include "scr17_c.inc"
904C-----------------------------------------------
905 INTEGER UID,SUB_ID
906 CHARACTER(LEN=NCHARTITLE) :: TITR
907 CHARACTER(LEN=NCHARKEY) :: KEY2,KEY3
908C-----------------------------------------------
909 INTEGER I,J1,J2,J3,J, JMAX
910 CHARACTER(LEN=NCHARFIELD) :: MOT1
911C-----------------------------------------------
912C /KEYW/KEY2/KEY3/u_id
913C /KEYW/KEY2/u_id
914C /KEYW/u_id
915C-----------------------------------------------
916
917 jmax = ncharline
918
919C Pass KEY1
920 uid=0
921 sub_id = 0
922 i=2
923 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
924 i=i+1
925 ENDDO
926 key2=' '
927 key3=' '
928 i=i+1
929 IF(i>ncharline)RETURN
930C Read KEY2
931 j1=i
932 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
933 i=i+1
934 ENDDO
935 IF (i>=ncharline) THEN
936 mot1=kline(j1:i)
937 IF (kline(j1:min(jmax,j1+2))/='AUX' .AND.
938 . kline(j1:min(jmax,j1+3))/='EPSP' .AND.
939 . kline(j1:min(jmax,j1+5))/='EPSP_F' .AND.
940 . kline(j1:min(jmax,j1+4))/='ORTHO' .AND.
941 . kline(j1:min(jmax,j1+5))/='STRA_F' .AND.
942 . kline(j1:min(jmax,j1+5))/='STRS_F' .AND.
943 . kline(j1:min(jmax,j1+4))/='THICK' .AND.
944 . kline(j1:min(jmax,j1+7))/='ORTH_LOC'.AND.
945 . kline(j1:min(jmax,j1+5))/='STRESS' .AND.
946 . kline(j1:min(jmax,j1+9))/='SCALE_YLD'.AND.
947 . kline(j1:min(jmax,j1+4))/='FAIL' .AND.
948 . kline(j1:min(jmax,j1+4))/='FILL' .AND.
949 . kline(j1:min(jmax,j1+4))/='FULL' .AND.
950 . kline(j1:min(jmax,j1+3))/='DENS' .AND.
951 . kline(j1:min(jmax,j1+3))/='EREF' .AND.
952 . kline(j1:min(jmax,j1+3))/='ENER' ) THEN
953 READ(mot1,err=999,fmt=fmt_i)uid
954 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
955 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,i1=uid,c1=kline)
956 RETURN
957 ENDIF
958 RETURN
959 ENDIF
960 ENDIF
961 IF (kline(j1:min(jmax,j1+2))=='AUX') THEN
962 j2=j1+3
963 ENDIF
964 IF (kline(j1:min(jmax,j1+3))=='EPSP') THEN
965 j2=j1+4
966 ENDIF
967 IF (kline(j1:min(jmax,j1+5))=='EPSP_F') THEN
968 j2=j1+6
969 ENDIF
970 IF (kline(j1:min(jmax,j1+4))=='ORTHO') THEN
971 j2=j1+5
972 ENDIF
973 IF (kline(j1:min(jmax,j1+8))=='STRA_FGLO') THEN
974 j2=j1+6
975 ELSEIF (kline(j1:min(jmax,j1+5))=='STRA_F') THEN
976 j2=j1+6
977 ENDIF
978 IF (kline(j1:min(jmax,j1+8))=='STRS_FGLO') THEN
979 j2=j1+9
980 ELSEIF (kline(j1:min(jmax,j1+5))=='STRS_F') THEN
981 j2=j1+6
982 ENDIF
983 IF (kline(j1:min(jmax,j1+4))=='THICK') THEN
984 j2=j1+5
985 ENDIF
986 IF (kline(j1:min(jmax,j1+7))=='ORTH_LOC') THEN
987 j2=j1+8
988 ENDIF
989 IF (kline(j1:min(jmax,j1+5))=='STRESS') THEN
990 j2=j1+6
991 ENDIF
992 IF (kline(j1:min(jmax,j1+9))=='SCALE_YLD') THEN
993 j2=j1+9
994 ENDIF
995 IF (kline(j1:min(jmax,j1+5))=='FAIL') THEN
996 j2=j1+4
997 ENDIF
998 IF (kline(j1:min(jmax,j1+5))=='FILL') THEN
999 j2=j1+4
1000 ENDIF
1001 IF (kline(j1:min(jmax,j1+5))=='FULL') THEN
1002 j2=j1+4
1003 ENDIF
1004 IF (kline(j1:min(jmax,j1+3))=='DENS') THEN
1005 j2=j1+4
1006 ENDIF
1007 IF (kline(j1:min(jmax,j1+3))=='ENER') THEN
1008 j2=j1+4
1009 ENDIF
1010 IF (kline(j1:min(jmax,j1+3))=='EREF') THEN
1011 j2=j1+4
1012 ENDIF
1013 key2=kline(j1:min(jmax,j2-1))
1014C Read KEY3
1015 DO WHILE(kline(i:i)/='/'.AND.i<ncharline)
1016 i=i+1
1017 ENDDO
1018 j2 = i+1
1019 j2 = min(jmax,j2)
1020 IF (i>=ncharline) THEN
1021 mot1=kline(j2:i)
1022 IF (kline(j2:min(jmax,j2+5))/='STRA_F'.AND.
1023 . kline(j2:min(jmax,j2+5))/='STRS_F') THEN
1024 READ(mot1,err=999,fmt=fmt_i)uid
1025 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
1026 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
1027 . i1=uid,c1=kline)
1028 RETURN
1029 ENDIF
1030 RETURN
1031 ENDIF
1032 ENDIF
1033 IF (kline(j2:min(jmax,j2+3))=='GLOB') THEN
1034 j3=j2+3
1035 j3 = min(jmax,j3)
1036 i = j3
1037 key3=kline(j2:j3)
1038 DO WHILE(kline(i:i)/='/' .AND. i<ncharline)
1039 i=i+1
1040 ENDDO
1041 i=i+1
1042 i=min(ncharline,i)
1043 ELSEIF (kline(j2:min(jmax,j2+8))=='STRA_FGLO' .OR.
1044 . kline(j2:min(jmax,j2+8))=='STRS_FGLO' ) THEN
1045 j3=j2+8
1046 j3 = min(jmax,j3)
1047 i = j3
1048 key3=kline(j2:j3)
1049 DO WHILE(kline(i:i)/='/' .AND. i<ncharline)
1050 i=i+1
1051 ENDDO
1052 i=i+1
1053 i=min(jmax,i)
1054 ELSEIF (kline(j2:min(jmax,j2+5))=='STRA_F' .OR.
1055 . kline(j2:min(jmax,j2+5))=='STRS_F' ) THEN
1056 j3=j2+5
1057 j3 = min(jmax,j3)
1058 i = j3
1059 key3=kline(j2:j3)
1060 DO WHILE(kline(i:i)/='/' .AND. i<ncharline)
1061 i=i+1
1062 ENDDO
1063 i=i+1
1064 i = min(jmax,i)
1065 ELSE
1066 j3=j2
1067 i=i+1
1068 i = min(jmax,i)
1069 key3=' '
1070 ENDIF
1071C--- read UID
1072 j1=i
1073 DO WHILE(kline(i:i)/='/' .AND. i<ncharline)
1074 i=i+1
1075 ENDDO
1076 mot1=kline(j1:i-1)
1077 READ(mot1,err=999,fmt=fmt_i)uid
1078 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
1079 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,
1080 . i1=uid,c1=kline)
1081 ENDIF
1082C--- read SUB_ID
1083 i=i+1
1084 i = min(jmax,i)
1085 j1=i
1086 DO WHILE(kline(i:i)/='/' .AND. i<ncharline)
1087 i=i+1
1088 ENDDO
1089 mot1=kline(j1:i-1)
1090 READ(mot1,err=999,fmt=fmt_i)sub_id
1091C---
1092 RETURN
1093 999 CALL freerr(0)
1094 CALL my_exit(2)

◆ fredec_key_3id_t()

subroutine fredec_key_3id_t ( integer id,
integer uid,
integer vers,
character(len=nchartitle) titr )

Definition at line 1218 of file freform.F.

1219C-----------------------------------------------
1220C M o d u l e s
1221C-----------------------------------------------
1222 USE message_mod
1223 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
1224 USE format_mod , ONLY : fmt_i
1225 USE reader_old_mod , ONLY : kline, irec
1226 USE user_id_mod , ONLY : id_limit
1227C-----------------------------------------------
1228C I m p l i c i t T y p e s
1229C-----------------------------------------------
1230#include "implicit_f.inc"
1231C-----------------------------------------------
1232C C o m m o n B l o c k s
1233C-----------------------------------------------
1234#include "scr17_c.inc"
1235#include "units_c.inc"
1236C-----------------------------------------------
1237 INTEGER IOP,ID,UID,VERS
1238 CHARACTER(LEN=NCHARFIELD) :: MOT1
1239 CHARACTER(LEN=NCHARTITLE) :: TITR
1240 INTEGER I,J1,J2
1241C-----------------------------------------------
1242C /KEYW/int_id/uid/VERS
1243C-----------------------------------------------
1244 i=2
1245 DO WHILE(kline(i:i)/='/')
1246 i=i+1
1247 IF (i > ncharline)CALL freerr(0)
1248 ENDDO
1249 i=i+1
1250 IF (i > ncharline)CALL freerr(0)
1251C--- read ID
1252 j1=i
1253 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1254 i=i+1
1255 ENDDO
1256 IF (i > ncharline) CALL freerr(0)
1257 j2 = i-1
1258 mot1=kline(j1:j2)
1259 READ(mot1,err=999,fmt=fmt_i)id
1260 IF (id > id_limit%GLOBAL .OR. id <= 0) THEN
1261 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,i1=id,c1=kline)
1262 ENDIF
1263 i =i+1
1264C--- read UID
1265 j1=i
1266 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1267 i=i+1
1268 ENDDO
1269 IF (i > ncharline) CALL freerr(0)
1270 j2 = i-1
1271 mot1=kline(j1:j2)
1272 READ(mot1,err=999,fmt=fmt_i)uid
1273 IF (uid > id_limit%GLOBAL .OR. uid < 0) THEN
1274 CALL ancmsg(msgid=510,anmode=aninfo,msgtype=msgerror,i1=uid,c1=kline)
1275 ENDIF
1276 i =i+1
1277C--- read VERS
1278 j1=i
1279 DO WHILE(kline(i:i)/='/' .AND. i-j1 <= ncharfield)
1280 i=i+1
1281 ENDDO
1282 j2 = i-1
1283 mot1=kline(j1:j2)
1284 READ(mot1,err=999,fmt=fmt_i)vers
1285C--- read TITR
1286 irec=irec+1
1287 READ(iin,rec=irec,err=999,fmt='(A)') titr
1288C---
1289 RETURN
1290 999 CALL freerr(0)
1291 CALL my_exit(2)

◆ freerr()

subroutine freerr ( integer it)

Definition at line 505 of file freform.F.

506C-----------------------------------------------
507C M o d u l e s
508C-----------------------------------------------
509 USE reader_old_mod , ONLY : kline, line, key0, kcur, irec
510 USE message_mod
511C-----------------------------------------------
512C I m p l i c i t T y p e s
513C-----------------------------------------------
514#include "implicit_f.inc"
515C-----------------------------------------------
516C C o m m o n B l o c k s
517C-----------------------------------------------
518#include "scr17_c.inc"
519#include "units_c.inc"
520C-----------------------------------------------
521C D u m m y A r g u m e n t s
522C-----------------------------------------------
523 INTEGER IT
524C-----------------------------------------------
525C L o c a l V a r i a b l e s
526C-----------------------------------------------
527 INTEGER IT1
528C=======================================================================
529 it1 = it
530 IF(it1==3)THEN
531 it1=0
532 READ(iin,rec=irec,err=999,fmt='(A)')line
533 it1=1
534 999 CONTINUE
535 ENDIF
536 IF(it1==0)THEN
537 CALL ancmsg(msgid=54,
538 . anmode=aninfo,
539 . msgtype=msgerror,
540 . c1=kline)
541 ELSEIF(it1==1)THEN
542 CALL ancmsg(msgid=55,
543 . anmode=aninfo,
544 . msgtype=msgerror,
545 . c1=key0(kcur),
546 . c2=kline,
547 . c3=line)
548 ENDIF

◆ fretitl()

subroutine fretitl ( character, dimension(*) titr,
integer, dimension(*) iasc,
integer l )

Definition at line 619 of file freform.F.

620C-----------------------------------------------
621C M o d u l e s
622C-----------------------------------------------
623 USE names_and_titles_mod , ONLY : ncharline
624C-----------------------------------------------
625C I m p l i c i t T y p e s
626C-----------------------------------------------
627#include "implicit_f.inc"
628C-----------------------------------------------
629C D u m m y A r g u m e n t s
630C-----------------------------------------------
631 INTEGER L,IASC(*)
632 CHARACTER TITR*(*)
633C-----------------------------------------------
634C L o c a l V a r i a b l e s
635C-----------------------------------------------
636 INTEGER I,J, JMAX
637C-----------------------------------------------
638 j=1
639 jmax=min(ncharline,len(titr))
640 DO i=1,l
641 iasc(i)= ichar(titr(j:j))*65536
642 j = j+1
643 IF(j>jmax) EXIT ! Replacing ncharline by JMAX
644 iasc(i)= iasc(i) + ichar(titr(j:j))*256
645 j = j+1
646 IF(j>jmax) EXIT
647 iasc(i)= iasc(i) + ichar(titr(j:j))
648 j = j+1
649 IF(j>jmax) EXIT
650 ENDDO
651 RETURN

◆ fretitl2()

subroutine fretitl2 ( character, dimension(*) titr,
integer, dimension(*) iasc,
integer l )

Definition at line 803 of file freform.F.

804C-----------------------------------------------
805C M o d u l e s
806C-----------------------------------------------
807 USE names_and_titles_mod , ONLY : nchartitle
808C-----------------------------------------------
809C I m p l i c i t T y p e s
810C-----------------------------------------------
811#include "implicit_f.inc"
812C-----------------------------------------------
813C D u m m y A r g u m e n t s
814C-----------------------------------------------
815 INTEGER L,IASC(*)
816 CHARACTER TITR*(*)
817C-----------------------------------------------
818C L o c a l V a r i a b l e s
819C-----------------------------------------------
820 INTEGER I,J
821C-----------------------------------------------
822 j=1
823 DO i=1,l
824 titr(j:j)=char(iasc(i)/65536)
825 j=j+1
826 IF(j>nchartitle) EXIT
827 titr(j:j)=char(mod(iasc(i),65536)/256)
828 j=j+1
829 IF(j>nchartitle) EXIT
830 titr(j:j)=char(mod(iasc(i),256))
831 j=j+1
832 IF(j>nchartitle) EXIT
833 ENDDO
834 RETURN

◆ grfind()

integer function grfind ( integer igu,
type (group_), dimension(ngrnod) igrnod,
character mess )

Definition at line 436 of file freform.F.

437C-----------------------------------------------
438C M o d u l e s
439C-----------------------------------------------
440 USE message_mod
441 USE groupdef_mod
442C-----------------------------------------------
443C I m p l i c i t T y p e s
444C-----------------------------------------------
445#include "implicit_f.inc"
446C-----------------------------------------------
447C C o m m o n B l o c k s
448C-----------------------------------------------
449#include "com04_c.inc"
450C-----------------------------------------------
451 INTEGER IGU
452 CHARACTER MESS*40
453C-----------------------------------------------
454 TYPE (GROUP_) ,DIMENSION(NGRNOD) :: IGRNOD
455C-----------------------------------------------
456 INTEGER I,IG
457C-----------------------------------------------
458 ig=0
459 DO i=1,ngrnod
460 IF(igrnod(i)%ID==igu)THEN
461 ig=i
462 ENDIF
463 ENDDO
464C
465 IF(ig==0)THEN
466 CALL ancmsg(msgid=53,
467 . msgtype=msgerror,
468 . anmode=aninfo,
469 . i1=igu,
470 . c1='IN NODE GROUP SEARCH')
471 RETURN
472 ENDIF
473 grfind = ig
474C----
475 RETURN
groupdef_mod
Definition groupdef_mod.F:662
grfind
integer function grfind(igu, igrnod, mess)
Definition freform.F:437

◆ nextsla()

subroutine nextsla

Definition at line 845 of file freform.F.

846C-----------------------------------------------
847C M o d u l e s
848C-----------------------------------------------
849 USE reader_old_mod , ONLY : line, kline, key0, kcur, lkey0, irec
850C-----------------------------------------------
851C I m p l i c i t T y p e s
852C-----------------------------------------------
853#include "implicit_f.inc"
854C-----------------------------------------------
855C C o m m o n B l o c k s
856C-----------------------------------------------
857#include "scr17_c.inc"
858#include "units_c.inc"
859C-----------------------------------------------
860 IF (irec<=0) THEN
861 irec=1
862 READ(iin,rec=irec,err=999,fmt='(A)')line
863 ELSE
864 READ(iin,rec=irec,err=999,fmt='(A)')line
865 DO WHILE(line(1:1)/='/')
866 irec=irec+1
867 READ(iin,rec=irec,err=999,fmt='(A)')line
868 ENDDO
869 END IF
870 IF(line(2:1+lkey0(kcur))/=key0(kcur)(1:lkey0(kcur)))GOTO 999
871 kline=line
872 RETURN
873 999 CALL freerr(1)
874 CALL my_exit(2)

◆ nodgrnr5()

integer function nodgrnr5 ( integer igu,
integer igs,
integer, dimension(*) ibuf,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(*) itabm1,
character mess )

Definition at line 301 of file freform.F.

303C-----------------------------------------------
304C M o d u l e s
305C-----------------------------------------------
306 USE groupdef_mod
307 USE message_mod
308C-----------------------------------------------
309C I m p l i c i t T y p e s
310C-----------------------------------------------
311#include "implicit_f.inc"
312C-----------------------------------------------
313C C o m m o n B l o c k s
314C-----------------------------------------------
315#include "com04_c.inc"
316C-----------------------------------------------
317 INTEGER IGU,IGS,IBUF(*),ITABM1(*)
318 CHARACTER MESS*40
319C-----------------------------------------------
320 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
321C-----------------------------------------------
322 INTEGER I
323C=======================================================================
324 nodgrnr5 = 0
325 IF (igu > 0) THEN
326 igs=0
327 DO i=1,ngrnod
328 IF(igrnod(i)%ID == igu) THEN
329 igs=i
330 nodgrnr5 = igrnod(igs)%NENTITY
331 EXIT
332 ENDIF
333 ENDDO
334C
335 IF (igs == 0)THEN
336 CALL ancmsg(msgid=53,
337 . msgtype=msgerror,
338 . anmode=aninfo,
339 . c1= mess,
340 . i1=igu)
341 RETURN
342 ENDIF
343C
344 DO i=1,nodgrnr5
345 ibuf(i)=igrnod(igs)%ENTITY(i)
346 ENDDO
347 ENDIF
348C---
349 RETURN
nodgrnr5
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:303

◆ nodgrnr6()

integer function nodgrnr6 ( integer m,
integer igu,
integer igs,
integer, dimension(*) ibuf,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(*) itabm1,
character mess,
integer id )

Definition at line 362 of file freform.F.

364C-----------------------------------------------
365C M o d u l e s
366C-----------------------------------------------
367 USE groupdef_mod
368 USE message_mod
369C-----------------------------------------------
370C I m p l i c i t T y p e s
371C-----------------------------------------------
372#include "implicit_f.inc"
373C-----------------------------------------------
374C C o m m o n B l o c k s
375C-----------------------------------------------
376#include "com04_c.inc"
377C-----------------------------------------------
378C THIS FUNCTION REMOVES main NODE FROM SECND NODAL SET
379C IN THE KINEMATIC CONSTRAINT DEFINITION
380C-----------------------------------------------
381 INTEGER M,IGU,IGS,ID,IBUF(*),ITABM1(*)
382 CHARACTER MESS*40
383C-----------------------------------------------
384 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
385C-----------------------------------------------
386 INTEGER I, MFLAG
387C=======================================================================
388 nodgrnr6 = 0
389 IF (igu > 0) THEN
390 igs=0
391 DO i=1,ngrnod
392 IF(igrnod(i)%ID == igu) THEN
393 igs=i
394 nodgrnr6 = igrnod(igs)%NENTITY
395 EXIT
396 ENDIF
397 ENDDO
398C
399 IF (igs == 0)THEN
400 CALL ancmsg(msgid=53,
401 . msgtype=msgerror,
402 . anmode=aninfo,
403 . c1= mess,
404 . i1=igu)
405 RETURN
406 ENDIF
407C
408 mflag=0
409 DO i=1,nodgrnr6
410 IF(igrnod(igs)%ENTITY(i)==m) THEN
411 mflag=1
412 ELSE
413 ibuf(i-mflag)=igrnod(igs)%ENTITY(i)
414 ENDIF
415 ENDDO
416 IF(mflag==1) THEN
417 nodgrnr6=nodgrnr6-1
418 CALL ancmsg(msgid=1624,
419 . msgtype=msgwarning,
420 . anmode=aninfo_blind_1,
421 . i1=id)
422 ENDIF
423 ENDIF
424C---
425 RETURN
nodgrnr6
integer function nodgrnr6(m, igu, igs, ibuf, igrnod, itabm1, mess, id)
Definition freform.F:364