DAMASK with grid solvers  Revision: v2.0.3-2204-gdb1f2151
The Düsseldorf Advanced Material Simulation Kit with Grid Solvers
grid_mech_spectral_polarisation.f90
Go to the documentation of this file.
1 # 1 "/home/damask_user/GitLabCI_Pipeline_4301/DAMASK/src/grid/grid_mech_spectral_polarisation.f90"
2 # 1 "<built-in>"
3 # 1 "<command-line>"
4 # 1 "/home/damask_user/GitLabCI_Pipeline_4301/DAMASK/src/grid/grid_mech_spectral_polarisation.f90"
5 !--------------------------------------------------------------------------------------------------
10 !--------------------------------------------------------------------------------------------------
11 module grid_mech_spectral_polarisation
12 
13 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscsnes.h" 1
14 !
15 ! Include file for Fortran use of the SNES package in 1
16 !
17 
18 
19 
20 
21 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscksp.h" 1
22 !
23 !
24 ! Include file for Fortran use of the KSP package in 1
25 !
26 
27 
28 
29 
30 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscpc.h" 1
31 !
32 !
33 ! Include file for Fortran use of the PC (preconditioner) package in 1
34 !
35 
36 
37 
38 
39 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscmat.h" 1
40 !
41 !
42 ! Include file for Fortran use of the Mat package in 1
43 !
44 
45 
46 
47 
48 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscvec.h" 1
49 !
50 !
51 ! Include file for Fortran use of the Vec package in 1
52 !
53 
54 
55 
56 
57 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscao.h" 1
58 !
59 !
60 ! Include file for Fortran use of the AO (application ordering) package in 1
61 !
62 
63 
64 
65 
66 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscis.h" 1
67 !
68 !
69 ! Include file for Fortran use of the IS (index set) package in 1
70 !
71 
72 
73 
74 
75 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h" 1
76 !
77 !
78 ! Part of the base include file for Fortran use of 1.
79 ! Note: This file should contain only define statements and
80 ! not the declaration of variables.
81 
82 ! No spaces for #defines as some compilers (PGI) also adds
83 ! those additional spaces during preprocessing - bad for fixed format
84 !
85 
86 
87 
88 # 1 "/opt/petsc-3.10.3/Intel-18.4-IntelMPI-2018/include/petscconf.h" 1
89 
90 
91 
92 
93 
94 
95 
96 
97 
98 
99 
100 
101 
102 
103 
104 
105 
106 
107 
108 
109 
110 
111 
112 
113 
114 
115 
116 
117 
118 
119 
120 
121 
122 
123 
124 
125 
126 
127 
128 
129 
130 
131 
132 
133 
134 
135 
136 
137 
138 
139 
140 
141 
142 
143 
144 
145 
146 
147 
148 
149 
150 
151 
152 
153 
154 
155 
156 
157 
158 
159 
160 
161 
162 
163 
164 
165 
166 
167 
168 
169 
170 
171 
172 
173 
174 
175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 
189 
190 
191 
192 
193 
194 
195 
196 
197 
198 
199 
200 
201 
202 
203 
204 
205 
206 
207 
208 
209 
210 
211 
212 
213 
214 
215 
216 
217 
218 
219 
220 
221 
222 
223 
224 
225 
226 
227 
228 
229 
230 
231 
232 
233 
234 
235 
236 
237 
238 
239 
240 
241 
242 
243 
244 
245 
246 
247 
248 
249 
250 
251 
252 
253 
254 
255 
256 
257 
258 
259 
260 
261 
262 
263 
264 
265 
266 
267 
268 
269 
270 
271 
272 
273 
274 
275 
276 
277 
278 
279 
280 
281 
282 
283 
284 
285 
286 
287 
288 
289 
290 
291 
292 
293 
294 
295 
296 
297 
298 
299 
300 
301 
302 
303 
304 
305 
306 
307 
308 
309 
310 
311 
312 
313 
314 
315 
316 
317 
318 
319 
320 
321 
322 
323 
324 
325 
326 
327 
328 
329 
330 
331 
332 
333 
334 
335 
336 
337 
338 
339 
340 
341 
342 
343 
344 
345 
346 
347 
348 
349 
350 
351 
352 
353 
354 
355 
356 
357 
358 
359 
360 
361 
362 
363 
364 
365 
366 
367 
368 
369 
370 
371 
372 
373 
374 
375 
376 
377 
378 
379 
380 
381 
382 
383 
384 
385 
386 
387 
388 
389 
390 
391 
392 
393 
394 
395 
396 
397 
398 
399 
400 
401 
402 
403 
404 
405 
406 
407 
408 
409 
410 
411 
412 
413 
414 
415 
416 
417 
418 
419 
420 
421 
422 
423 
424 
425 
426 
427 
428 
429 
430 
431 
432 
433 
434 
435 
436 
437 
438 
439 
440 
441 
442 
443 
444 
445 
446 
447 
448 
449 
450 
451 
452 
453 
454 
455 
456 
457 
458 
459 
460 
461 
462 
463 
464 
465 
466 
467 
468 
469 
470 
471 
472 
473 
474 
475 
476 
477 
478 
479 
480 
481 
482 
483 
484 
485 
486 
487 
488 
489 
490 
491 
492 
493 
494 
495 
496 
497 
498 
499 
500 
501 
502 
503 
504 
505 
506 
507 
508 
509 
510 
511 
512 
513 
514 
515 
516 
517 
518 
519 
520 
521 
522 
523 
524 
525 
526 
527 
528 
529 
530 
531 
532 
533 
534 
535 
536 
537 
538 
539 
540 
541 
542 
543 
544 
545 
546 
547 
548 
549 
550 
551 
552 
553 
554 
555 
556 
557 
558 
559 
560 
561 
562 
563 
564 
565 
566 
567 
568 
569 
570 
571 
572 
573 
574 
575 
576 
577 
578 
579 
580 
581 
582 
583 
584 
585 
586 
587 
588 
589 
590 
591 
592 
593 
594 
595 
596 
597 
598 
599 
600 
601 
602 
603 
604 
605 
606 
607 
608 
609 
610 
611 
612 
613 
614 
615 
616 
617 
618 
619 
620 
621 
622 
623 
624 
625 
626 
627 
628 
629 
630 
631 
632 
633 
634 
635 
636 
637 
638 
639 
640 
641 
642 
643 
644 
645 
646 
647 
648 
649 
650 
651 
652 
653 
654 
655 
656 
657 
658 
659 
660 
661 
662 
663 
664 
665 
666 
667 
668 
669 
670 
671 
672 
673 
674 
675 
676 
677 
678 
679 
680 
681 
682 
683 
684 
685 
686 
687 
688 
689 
690 
691 
692 
693 
694 
695 
696 
697 
698 
699 
700 
701 
702 
703 
704 
705 
706 
707 
708 
709 
710 
711 
712 
713 
714 
715 
716 
717 
718 
719 
720 
721 
722 
723 
724 
725 
726 
727 
728 
729 
730 
731 
732 
733 
734 
735 
736 
737 
738 
739 
740 
741 
742 
743 
744 
745 
746 
747 
748 
749 
750 
751 
752 
753 
754 
755 
756 
757 
758 
759 
760 
761 
762 
763 
764 
765 
766 
767 
768 
769 
770 
771 
772 
773 
774 
775 
776 
777 
778 
779 
780 
781 
782 
783 
784 
785 
786 
787 
788 
789 
790 
791 
792 
793 
794 
795 
796 
797 
798 
799 
800 
801 
802 
803 
804 
805 
806 
807 
808 
809 
810 
811 
812 
813 
814 
815 
816 
817 
818 
819 
820 
821 
822 
823 
824 
825 
826 
827 
828 
829 
830 
831 
832 
833 
834 
835 
836 
837 
838 
839 
840 
841 
842 
843 
844 
845 
846 
847 
848 
849 
850 
851 
852 
853 
854 
855 
856 
857 
858 
859 
860 
861 
862 
863 
864 
865 
866 
867 
868 
869 
870 
871 
872 
873 
874 
875 
876 
877 
878 
879 
880 
881 
882 
883 
884 
885 
886 
887 
888 
889 
890 
891 
892 
893 
894 
895 
896 
897 
898 
899 
900 
901 
902 
903 
904 
905 
906 
907 
908 
909 
910 
911 
912 
913 
914 
915 
916 
917 
918 
919 
920 
921 
922 
923 
924 
925 
926 
927 
928 
929 
930 
931 
932 
933 
934 
935 
936 
937 
938 
939 
940 
941 
942 
943 
944 
945 
946 
947 
948 
949 
950 
951 
952 
953 
954 
955 
956 
957 
958 
959 
960 
961 
962 
963 
964 
965 
966 
967 
968 
969 
970 
971 
972 
973 
974 
975 
976 
977 
978 
979 
980 
981 
982 
983 
984 
985 
986 
987 
988 
989 
990 
991 
992 
993 
994 
995 
996 
997 
998 
999 
1000 
1001 
1002 
1003 
1004 
1005 
1006 
1007 
1008 
1009 
1010 
1011 
1012 
1013 
1014 
1015 
1016 
1017 
1018 
1019 
1020 
1021 
1022 
1023 
1024 
1025 
1026 
1027 
1028 
1029 
1030 
1031 
1032 
1033 
1034 
1035 
1036 
1037 
1038 
1039 
1040 
1041 
1042 
1043 
1044 
1045 
1046 
1047 
1048 
1049 
1050 
1051 
1052 
1053 
1054 
1055 
1056 
1057 
1058 
1059 
1060 
1061 
1062 
1063 
1064 
1065 
1066 
1067 
1068 
1069 
1070 
1071 
1072 
1073 
1074 
1075 
1076 
1077 
1078 
1079 
1080 
1081 
1082 
1083 
1084 
1085 
1086 
1087 
1088 
1089 
1090 
1091 
1092 
1093 
1094 
1095 
1096 
1097 
1098 
1099 
1100 
1101 
1102 
1103 
1104 
1105 
1106 
1107 
1108 
1109 
1110 
1111 
1112 
1113 
1114 
1115 
1116 
1117 
1118 
1119 
1120 
1121 
1122 
1123 
1124 
1125 
1126 
1127 
1128 
1129 
1130 
1131 
1132 
1133 
1134 
1135 
1136 
1137 
1138 
1139 
1140 
1141 
1142 
1143 
1144 
1145 
1146 
1147 
1148 
1149 
1150 
1151 
1152 
1153 
1154 
1155 
1156 
1157 
1158 
1159 
1160 
1161 
1162 
1163 
1164 
1165 
1166 
1167 
1168 
1169 
1170 
1171 
1172 
1173 
1174 
1175 
1176 
1177 
1178 
1179 
1180 
1181 
1182 
1183 
1184 
1185 
1186 
1187 
1188 
1189 
1190 
1191 
1192 
1193 
1194 
1195 
1196 
1197 
1198 
1199 
1200 
1201 
1202 
1203 
1204 
1205 
1206 
1207 
1208 
1209 
1210 
1211 
1212 
1213 
1214 
1215 
1216 
1217 
1218 
1219 
1220 
1221 
1222 
1223 
1224 
1225 
1226 
1227 
1228 
1229 
1230 
1231 
1232 
1233 
1234 
1235 
1236 
1237 
1238 
1239 
1240 
1241 
1242 
1243 
1244 
1245 
1246 
1247 
1248 
1249 
1250 
1251 
1252 
1253 
1254 
1255 
1256 
1257 
1258 
1259 
1260 
1261 
1262 
1263 
1264 
1265 
1266 
1267 
1268 
1269 
1270 
1271 
1272 
1273 
1274 
1275 
1276 
1277 
1278 
1279 
1280 
1281 
1282 
1283 
1284 
1285 
1286 
1287 
1288 
1289 
1290 
1291 
1292 
1293 
1294 
1295 
1296 # 13 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h" 2
1297 
1298 
1299 
1300 
1301 # 1 "/opt/petsc-3.10.3/include/petscversion.h" 1
1302 
1303 
1304 
1305 
1306 
1307 
1308 
1309 
1310 
1311 
1312 
1313 
1314 
1315 
1316 
1317 
1318 
1319 
1320 
1321 
1322 
1323 
1324 
1325 
1326 
1327 
1328 
1329 
1330 
1331 
1332 
1333 
1334 
1335 
1336 
1337 
1338 
1339 
1340 
1341 
1342 
1343 
1344 
1345 
1346 
1347 # 17 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h" 2
1348 
1349 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscviewer.h" 1
1350 !
1351 ! Include file for Fortran use of the PetscViewer package in 1
1352 !
1353 
1354 
1355 
1356 
1357 
1358 
1359 
1360 
1361 
1362 
1363 
1364 
1365 
1366 # 31 "/opt/petsc-3.10.3/include/petsc/finclude/petscviewer.h"
1367 
1368 # 18 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h" 2
1369 
1370 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscerror.h" 1
1371 
1372 !
1373 ! Include file for Fortran error codes
1374 ! These are also in include/petscerror.h
1375 !
1376 
1377 
1378 
1379 # 24 "/opt/petsc-3.10.3/include/petsc/finclude/petscerror.h"
1380 
1381 # 38 "/opt/petsc-3.10.3/include/petsc/finclude/petscerror.h"
1382 
1383 
1384 
1385 
1386 
1387 
1388 
1389 
1390 
1391 
1392 
1393 
1394 
1395 
1396 
1397 
1398 # 19 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h" 2
1399 
1400 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petsclog.h" 1
1401 !
1402 ! No includes needed for logging
1403 # 20 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h" 2
1404 
1405 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscbag.h" 1
1406 !
1407 !
1408 ! Include file for Fortran use of the Bag package in 1
1409 !
1410 
1411 
1412 
1413 
1414 
1415 !
1416 ! End of Fortran include file for the IS package in 1
1417 
1418 # 21 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h" 2
1419 
1420 !
1421 ! The real*8,complex*16 notatiton is used so that the
1422 ! 1 double/complex variables are not affected by
1423 ! compiler options like -r4,-r8, sometimes invoked
1424 ! by the user. NAG compiler does not like integer*4,real*8
1425 
1426 # 41 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h"
1427 
1428 
1429 
1430 
1431 
1432 
1433 
1434 
1435 
1436 # 63 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h"
1437 
1438 
1439 
1440 
1441 
1442 
1443 !
1444 
1445 
1446 
1447 
1448 
1449 !
1450 # 85 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h"
1451 !
1452 
1453 
1454 
1455 
1456 
1457 
1458 !
1459 
1460 
1461 
1462 
1463 !
1464 
1465 !
1466 
1467 
1468 !
1469 # 128 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h"
1470 
1471 # 150 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h"
1472 !
1473 ! Macro for templating between real and complex
1474 !
1475 # 174 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h"
1476 
1477 
1478 
1479 
1480 
1481 
1482 
1483 
1484 
1485 !
1486 ! Allows the matrix Fortran Kernels to work with single precision
1487 ! matrix data structures
1488 !
1489 
1490 !
1491 ! PetscLogDouble variables are used to contain double precision numbers
1492 ! that are not used in the numerical computations, but rather in logging,
1493 ! timing etc.
1494 !
1495 
1496 
1497 !
1498 ! Macros for error checking
1499 !
1500 
1501 
1502 
1503 
1504 
1505 
1506 
1507 
1508 # 215 "/opt/petsc-3.10.3/include/petsc/finclude/petscsys.h"
1509 
1510 
1511 
1512 
1513 
1514 
1515 
1516 
1517 
1518 
1519 
1520 
1521 # 9 "/opt/petsc-3.10.3/include/petsc/finclude/petscis.h" 2
1522 
1523 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscviewer.h" 1
1524 !
1525 ! Include file for Fortran use of the type(tPetscViewer) package in 1
1526 !
1527 # 10 "/opt/petsc-3.10.3/include/petsc/finclude/petscis.h" 2
1528 
1529 
1530 
1531 
1532 
1533 
1534 
1535 
1536 
1537 
1538 
1539 
1540 
1541 
1542 
1543 
1544 
1545 
1546 
1547 
1548 
1549 # 9 "/opt/petsc-3.10.3/include/petsc/finclude/petscao.h" 2
1550 
1551 
1552 
1553 
1554 
1555 
1556 
1557 
1558 
1559 # 9 "/opt/petsc-3.10.3/include/petsc/finclude/petscvec.h" 2
1560 
1561 
1562 
1563 
1564 
1565 
1566 
1567 
1568 
1569 
1570 
1571 
1572 
1573 # 30 "/opt/petsc-3.10.3/include/petsc/finclude/petscvec.h"
1574 
1575 
1576 
1577 # 9 "/opt/petsc-3.10.3/include/petsc/finclude/petscmat.h" 2
1578 
1579 
1580 
1581 
1582 
1583 # 49 "/opt/petsc-3.10.3/include/petsc/finclude/petscmat.h"
1584 
1585 
1586 
1587 
1588 
1589 
1590 
1591 
1592 
1593 
1594 
1595 
1596 
1597 # 71 "/opt/petsc-3.10.3/include/petsc/finclude/petscmat.h"
1598 !
1599 ! Matrix types
1600 !
1601 # 115 "/opt/petsc-3.10.3/include/petsc/finclude/petscmat.h"
1602 
1603 # 140 "/opt/petsc-3.10.3/include/petsc/finclude/petscmat.h"
1604 
1605 !
1606 ! MatMFFDType values
1607 !
1608 
1609 
1610 
1611 !
1612 ! MatSolverTypes
1613 !
1614 # 168 "/opt/petsc-3.10.3/include/petsc/finclude/petscmat.h"
1615 
1616 !
1617 ! GPU Storage Formats for CUSPARSE
1618 !
1619 
1620 
1621 
1622 !
1623 ! sparsity reducing ordering for STRUMPACK
1624 !
1625 
1626 
1627 # 9 "/opt/petsc-3.10.3/include/petsc/finclude/petscpc.h" 2
1628 
1629 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscdm.h" 1
1630 
1631 !
1632 ! Include file for Fortran use of the DM package in 1
1633 !
1634 
1635 
1636 
1637 
1638 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscis.h" 1
1639 !
1640 !
1641 ! Include file for Fortran use of the type(tIS) (index set) package in 1
1642 !
1643 # 9 "/opt/petsc-3.10.3/include/petsc/finclude/petscdm.h" 2
1644 
1645 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscvec.h" 1
1646 !
1647 !
1648 ! Include file for Fortran use of the type(tVec) package in 1
1649 !
1650 # 10 "/opt/petsc-3.10.3/include/petsc/finclude/petscdm.h" 2
1651 
1652 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscmat.h" 1
1653 !
1654 !
1655 ! Include file for Fortran use of the type(tMat) package in 1
1656 !
1657 # 11 "/opt/petsc-3.10.3/include/petsc/finclude/petscdm.h" 2
1658 
1659 
1660 
1661 
1662 
1663 
1664 
1665 
1666 
1667 
1668 
1669 # 32 "/opt/petsc-3.10.3/include/petsc/finclude/petscdm.h"
1670 
1671 
1672 # 47 "/opt/petsc-3.10.3/include/petsc/finclude/petscdm.h"
1673 
1674 # 10 "/opt/petsc-3.10.3/include/petsc/finclude/petscpc.h" 2
1675 
1676 
1677 
1678 # 26 "/opt/petsc-3.10.3/include/petsc/finclude/petscpc.h"
1679 !
1680 ! GAMG types
1681 !
1682 
1683 
1684 !
1685 ! Various preconditioners
1686 !
1687 # 74 "/opt/petsc-3.10.3/include/petsc/finclude/petscpc.h"
1688 
1689 # 9 "/opt/petsc-3.10.3/include/petsc/finclude/petscksp.h" 2
1690 
1691 
1692 
1693 
1694 # 21 "/opt/petsc-3.10.3/include/petsc/finclude/petscksp.h"
1695 !
1696 ! Various Krylov subspace methods
1697 !
1698 # 57 "/opt/petsc-3.10.3/include/petsc/finclude/petscksp.h"
1699 !
1700 ! Various Initial guesses for Krylov subspace methods
1701 !
1702 # 8 "/opt/petsc-3.10.3/include/petsc/finclude/petscsnes.h" 2
1703 
1704 
1705 
1706 
1707 
1708 # 30 "/opt/petsc-3.10.3/include/petsc/finclude/petscsnes.h"
1709 
1710 !
1711 ! character*(80)
1712 !
1713 # 47 "/opt/petsc-3.10.3/include/petsc/finclude/petscsnes.h"
1714 
1715 !
1716 ! character*(80)
1717 !
1718 
1719 
1720 
1721 
1722 
1723 
1724 
1725 !
1726 ! integer(kind=selected_int_kind(5))
1727 !
1728 
1729 
1730 
1731 
1732 
1733 
1734 !
1735 ! character*(80)
1736 !
1737 # 78 "/opt/petsc-3.10.3/include/petsc/finclude/petscsnes.h"
1738 
1739 
1740 
1741 # 9 "/home/damask_user/GitLabCI_Pipeline_4301/DAMASK/src/grid/grid_mech_spectral_polarisation.f90" 2
1742 
1743 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscdmda.h" 1
1744 
1745 !
1746 ! Include file for Fortran use of the 'da' (distributed array) package in 1
1747 !
1748 
1749 
1750 
1751 
1752 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscis.h" 1
1753 !
1754 !
1755 ! Include file for Fortran use of the type(tIS) (index set) package in 1
1756 !
1757 # 9 "/opt/petsc-3.10.3/include/petsc/finclude/petscdmda.h" 2
1758 
1759 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscvec.h" 1
1760 !
1761 !
1762 ! Include file for Fortran use of the type(tVec) package in 1
1763 !
1764 # 10 "/opt/petsc-3.10.3/include/petsc/finclude/petscdmda.h" 2
1765 
1766 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscmat.h" 1
1767 !
1768 !
1769 ! Include file for Fortran use of the type(tMat) package in 1
1770 !
1771 # 11 "/opt/petsc-3.10.3/include/petsc/finclude/petscdmda.h" 2
1772 
1773 # 1 "/opt/petsc-3.10.3/include/petsc/finclude/petscdm.h" 1
1774 
1775 !
1776 ! Include file for Fortran use of the type(tDM) package in 1
1777 !
1778 # 12 "/opt/petsc-3.10.3/include/petsc/finclude/petscdmda.h" 2
1779 
1780 
1781 
1782 
1783 
1784 !
1785 ! DMDA_LOCAL_INFO_SIZE is one large than the size incase the DA is larger than an integer (on 64 bit systems).
1786 ! non-int fields are not accessiable from fortran.
1787 !
1788 # 39 "/opt/petsc-3.10.3/include/petsc/finclude/petscdmda.h"
1789 
1790 
1791 
1792 
1793 
1794 
1795 
1796 
1797 
1798 
1799 
1800 
1801 
1802 # 10 "/home/damask_user/GitLabCI_Pipeline_4301/DAMASK/src/grid/grid_mech_spectral_polarisation.f90" 2
1803  use petscdmda
1804  use petscsnes
1805 
1806  use prec
1807  use damask_interface
1808  use hdf5_utilities
1809  use math
1810  use rotations
1811  use spectral_utilities
1812  use fesolving
1813  use config
1814  use numerics
1815  use homogenization
1816  use discretization_grid
1817  use debug
1818 
1819  implicit none
1820  private
1821 
1822 !--------------------------------------------------------------------------------------------------
1823 ! derived types
1824  type(tsolutionparams), private :: params
1825 
1826  type, private :: tnumerics
1827  logical :: update_gamma
1828  end type tnumerics
1829 
1830  type(tnumerics) :: num ! numerics parameters. Better name?
1831 
1832 !--------------------------------------------------------------------------------------------------
1833 ! 1 data
1834  type(tdm), private :: da
1835  type(tsnes), private :: snes
1836  type(tvec), private :: solution_vec
1837 
1838 !--------------------------------------------------------------------------------------------------
1839 ! common pointwise data
1840  real(preal), private, dimension(:,:,:,:,:), allocatable :: &
1841  f_lastinc, & !< field of previous compatible deformation gradients
1842  f_tau_lastinc, & !< field of previous incompatible deformation gradient
1843  fdot, & !< field of assumed rate of compatible deformation gradient
1844  f_taudot
1845 
1846 !--------------------------------------------------------------------------------------------------
1847 ! stress, stiffness and compliance average etc.
1848  real(preal), private, dimension(3,3) :: &
1849  f_aimdot = 0.0_preal, &
1850  f_aim = math_i3, &
1851  f_aim_lastinc = math_i3, &
1852  f_av = 0.0_preal, &
1853  p_av = 0.0_preal
1854 
1855  character(len=pStringLen), private :: incinfo
1856  real(preal), private, dimension(3,3,3,3) :: &
1857  c_volavg = 0.0_preal, &
1858  c_volavglastinc = 0.0_preal, &
1859  c_minmaxavg = 0.0_preal, &
1860  c_minmaxavglastinc = 0.0_preal, &
1861  s = 0.0_preal, &
1862  c_scale = 0.0_preal, &
1863  s_scale = 0.0_preal
1864 
1865  real(preal), private :: &
1866  err_bc, & !< deviation from stress BC
1867  err_curl, & !< RMS of curl of F
1868  err_div
1869 
1870  integer, private :: &
1871  totaliter = 0
1872 
1873  public :: &
1874  grid_mech_spectral_polarisation_init, &
1875  grid_mech_spectral_polarisation_solution, &
1876  grid_mech_spectral_polarisation_forward, &
1877  grid_mech_spectral_polarisation_updatecoords, &
1878  grid_mech_spectral_polarisation_restartwrite
1879 
1880 contains
1881 
1882 !--------------------------------------------------------------------------------------------------
1884 !--------------------------------------------------------------------------------------------------
1885 subroutine grid_mech_spectral_polarisation_init
1886 
1887  real(preal), dimension(3,3,grid(1),grid(2),grid3) :: p
1888  real(preal), dimension(3,3) :: &
1889  temp33_real = 0.0_preal
1890 
1891  integer(kind=selected_int_kind(5)) :: ierr
1892  real(kind=selected_real_kind(10)), pointer, dimension(:,:,:,:) :: &
1893  fandf_tau, & ! overall pointer to solution data
1894  f, & ! specific (sub)pointer
1895  f_tau ! specific (sub)pointer
1896  integer(kind=selected_int_kind(5)), dimension(0:worldsize-1) :: localk
1897  integer(HID_T) :: filehandle, grouphandle
1898  integer :: fileunit
1899  character(len=pStringLen) :: filename
1900 
1901  write(6,'(/,a)') ' <<<+- grid_mech_spectral_polarisation init -+>>>'; flush(6)
1902 
1903  write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
1904  write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
1905 
1906  num%update_gamma = config_numerics%getInt('update_gamma',defaultval=0) > 0
1907 
1908 !--------------------------------------------------------------------------------------------------
1909 ! set default and user defined options for 1
1910  call petscoptionsinsertstring(petsc_null_options,'-mech_snes_type ngmres',ierr)
1911  if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
1912  call petscoptionsinsertstring(petsc_null_options,trim(petsc_options),ierr)
1913  if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
1914 
1915 !--------------------------------------------------------------------------------------------------
1916 ! allocate global fields
1917  allocate(f_lastinc(3,3,grid(1),grid(2),grid3),source = 0.0_preal)
1918  allocate(fdot(3,3,grid(1),grid(2),grid3),source = 0.0_preal)
1919  allocate(f_tau_lastinc(3,3,grid(1),grid(2),grid3),source = 0.0_preal)
1920  allocate(f_taudot(3,3,grid(1),grid(2),grid3),source = 0.0_preal)
1921 
1922 !--------------------------------------------------------------------------------------------------
1923 ! initialize solver specific parts of 1
1924  call snescreate(petsc_comm_world,snes,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
1925  call snessetoptionsprefix(snes,'mech_',ierr);if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
1926  localk = 0
1927  localk(worldrank) = grid3
1928  call mpi_allreduce(mpi_in_place,localk,worldsize,mpi_integer,mpi_sum,petsc_comm_world,ierr)
1929  call dmdacreate3d(petsc_comm_world, &
1930  dm_boundary_none, dm_boundary_none, dm_boundary_none, & ! cut off stencil at boundary
1931  dmda_stencil_box, & ! Moore (26) neighborhood around central point
1932  grid(1),grid(2),grid(3), & ! global grid
1933  1 , 1, worldsize, &
1934  18, 0, & ! #dof (F tensor), ghost boundary width (domain overlap)
1935  [grid(1)],[grid(2)],localk, & ! local grid
1936  da,ierr) ! handle, error
1937  if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
1938  call snessetdm(snes,da,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif ! connect snes to da
1939  call dmsetfromoptions(da,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
1940  call dmsetup(da,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
1941  call dmcreateglobalvector(da,solution_vec,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif ! global solution vector (grid x 18, i.e. every def grad tensor)
1942  call dmdasnessetfunctionlocal(da,insert_values,formresidual,petsc_null_snes,ierr) ! residual vector of same shape as solution vector
1943  if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
1944  call snessetconvergencetest(snes,converged,petsc_null_snes,petsc_null_function,ierr) ! specify custom convergence check function "converged"
1945  if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
1946  call snessetfromoptions(snes,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif ! pull it all together with additional CLI arguments
1947 
1948 !--------------------------------------------------------------------------------------------------
1949 ! init fields
1950  call dmdavecgetarrayf90(da,solution_vec,fandf_tau,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif ! places pointer on 1 data
1951  f => fandf_tau(0: 8,:,:,:)
1952  f_tau => fandf_tau(9:17,:,:,:)
1953 
1954  restartread: if (interface_restartinc > 0) then
1955  write(6,'(/,a,i0,a)') ' reading restart data of increment ', interface_restartinc, ' from file'
1956 
1957  write(filename,'(a,a,i0,a)') trim(getsolverjobname()),'_',worldrank,'.hdf5'
1958  filehandle = hdf5_openfile(filename)
1959  grouphandle = hdf5_opengroup(filehandle,'solver')
1960 
1961  call hdf5_read(grouphandle,f_aim, 'F_aim')
1962  call hdf5_read(grouphandle,f_aim_lastinc,'F_aim_lastInc')
1963  call hdf5_read(grouphandle,f_aimdot, 'F_aimDot')
1964  call hdf5_read(grouphandle,f, 'F')
1965  call hdf5_read(grouphandle,f_lastinc, 'F_lastInc')
1966  call hdf5_read(grouphandle,f_tau, 'F_tau')
1967  call hdf5_read(grouphandle,f_tau_lastinc,'F_tau_lastInc')
1968 
1969  elseif (interface_restartinc == 0) then restartread
1970  f_lastinc = spread(spread(spread(math_i3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity
1971  f = reshape(f_lastinc,[9,grid(1),grid(2),grid3])
1972  f_tau = 2.0_preal*f
1973  f_tau_lastinc = 2.0_preal*f_lastinc
1974  endif restartread
1975 
1976  materialpoint_f0 = reshape(f_lastinc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent
1977  call utilities_updatecoords(reshape(f,shape(f_lastinc)))
1978  call utilities_constitutiveresponse(p,temp33_real,c_volavg,c_minmaxavg, & ! stress field, stress avg, global average of stiffness and (min+max)/2
1979  reshape(f,shape(f_lastinc)), & ! target F
1980  0.0_preal) ! time increment
1981  call dmdavecrestorearrayf90(da,solution_vec,fandf_tau,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif ! deassociate pointer
1982 
1983  restartread2: if (interface_restartinc > 0) then
1984  write(6,'(/,a,i0,a)') ' reading more restart data of increment ', interface_restartinc, ' from file'
1985  call hdf5_read(grouphandle,c_volavg, 'C_volAvg')
1986  call hdf5_read(grouphandle,c_volavglastinc,'C_volAvgLastInc')
1987 
1988  call hdf5_closegroup(grouphandle)
1989  call hdf5_closefile(filehandle)
1990 
1991  call mpi_file_open(petsc_comm_world, trim(getsolverjobname())//'.C_ref', &
1992  mpi_mode_rdonly,mpi_info_null,fileunit,ierr)
1993  call mpi_file_read(fileunit,c_minmaxavg,81,mpi_double,mpi_status_ignore,ierr)
1994  call mpi_file_close(fileunit,ierr)
1995  endif restartread2
1996 
1997  call utilities_updategamma(c_minmaxavg)
1998  call utilities_savereferencestiffness
1999  c_scale = c_minmaxavg
2000  s_scale = math_invsym3333(c_minmaxavg)
2001 
2002 end subroutine grid_mech_spectral_polarisation_init
2003 
2004 
2005 !--------------------------------------------------------------------------------------------------
2007 !--------------------------------------------------------------------------------------------------
2008 function grid_mech_spectral_polarisation_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) result(solution)
2009 
2010 !--------------------------------------------------------------------------------------------------
2011 ! input data for solution
2012  character(len=*), intent(in) :: &
2013  incinfoin
2014  real(preal), intent(in) :: &
2015  timeinc, & !< time increment of current solution
2016  timeinc_old
2017  type(tboundarycondition), intent(in) :: &
2018  stress_bc
2019  type(rotation), intent(in) :: &
2020  rotation_bc
2021  type(tsolutionstate) :: &
2022  solution
2023 !--------------------------------------------------------------------------------------------------
2024 ! 1 Data
2025  integer(kind=selected_int_kind(5)) :: ierr
2026  integer(kind=selected_int_kind(5)) :: reason
2027 
2028  incinfo = incinfoin
2029 
2030 !--------------------------------------------------------------------------------------------------
2031 ! update stiffness (and gamma operator)
2032  s = utilities_maskedcompliance(rotation_bc,stress_bc%maskLogical,c_volavg)
2033  if (num%update_gamma) then
2034  call utilities_updategamma(c_minmaxavg)
2035  c_scale = c_minmaxavg
2036  s_scale = math_invsym3333(c_minmaxavg)
2037  endif
2038 
2039 !--------------------------------------------------------------------------------------------------
2040 ! set module wide available data
2041  params%stress_mask = stress_bc%maskFloat
2042  params%stress_BC = stress_bc%values
2043  params%rotation_BC = rotation_bc
2044  params%timeinc = timeinc
2045  params%timeincOld = timeinc_old
2046 
2047 !--------------------------------------------------------------------------------------------------
2048 ! solve BVP
2049  call snessolve(snes,petsc_null_vec,solution_vec,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
2050 
2051 !--------------------------------------------------------------------------------------------------
2052 ! check convergence
2053  call snesgetconvergedreason(snes,reason,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
2054 
2055  solution%converged = reason > 0
2056  solution%iterationsNeeded = totaliter
2057  solution%termIll = terminallyill
2058  terminallyill = .false.
2059 
2060 end function grid_mech_spectral_polarisation_solution
2061 
2062 
2063 !--------------------------------------------------------------------------------------------------
2067 !--------------------------------------------------------------------------------------------------
2068 subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,&
2069  deformation_BC,stress_BC,rotation_BC)
2070 
2071  logical, intent(in) :: &
2072  cutback, &
2073  guess
2074  real(preal), intent(in) :: &
2075  timeinc_old, &
2076  timeinc, &
2077  loadcasetime
2078  type(tboundarycondition), intent(in) :: &
2079  stress_bc, &
2080  deformation_bc
2081  type(rotation), intent(in) :: &
2082  rotation_bc
2083  integer(kind=selected_int_kind(5)) :: ierr
2084  real(kind=selected_real_kind(10)), dimension(:,:,:,:), pointer :: fandf_tau, f, f_tau
2085  integer :: i, j, k
2086  real(preal), dimension(3,3) :: f_lambda33
2087 
2088  call dmdavecgetarrayf90(da,solution_vec,fandf_tau,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
2089  f => fandf_tau(0: 8,:,:,:)
2090  f_tau => fandf_tau(9:17,:,:,:)
2091 
2092  if (cutback) then
2093  c_volavg = c_volavglastinc
2094  c_minmaxavg = c_minmaxavglastinc
2095  else
2096  c_volavglastinc = c_volavg
2097  c_minmaxavglastinc = c_minmaxavg
2098 
2099  f_aimdot = merge(stress_bc%maskFloat*(f_aim-f_aim_lastinc)/timeinc_old, 0.0_preal, guess)
2100  f_aim_lastinc = f_aim
2101 
2102  !-----------------------------------------------------------------------------------------------
2103  ! calculate rate for aim
2104  if (deformation_bc%myType=='l') then ! calculate F_aimDot from given L and current F
2105  f_aimdot = &
2106  f_aimdot + deformation_bc%maskFloat * matmul(deformation_bc%values, f_aim_lastinc)
2107  elseif(deformation_bc%myType=='fdot') then ! F_aimDot is prescribed
2108  f_aimdot = &
2109  f_aimdot + deformation_bc%maskFloat * deformation_bc%values
2110  elseif (deformation_bc%myType=='f') then ! aim at end of load case is prescribed
2111  f_aimdot = &
2112  f_aimdot + deformation_bc%maskFloat * (deformation_bc%values - f_aim_lastinc)/loadcasetime
2113  endif
2114 
2115  fdot = utilities_calculaterate(guess, &
2116  f_lastinc,reshape(f,[3,3,grid(1),grid(2),grid3]),timeinc_old, &
2117  rotation_bc%rotate(f_aimdot,active=.true.))
2118  f_taudot = utilities_calculaterate(guess, &
2119  f_tau_lastinc,reshape(f_tau,[3,3,grid(1),grid(2),grid3]), timeinc_old, &
2120  rotation_bc%rotate(f_aimdot,active=.true.))
2121  f_lastinc = reshape(f, [3,3,grid(1),grid(2),grid3])
2122  f_tau_lastinc = reshape(f_tau,[3,3,grid(1),grid(2),grid3])
2123 
2124  materialpoint_f0 = reshape(f,[3,3,1,product(grid(1:2))*grid3])
2125  endif
2126 
2127 !--------------------------------------------------------------------------------------------------
2128 ! update average and local deformation gradients
2129  f_aim = f_aim_lastinc + f_aimdot * timeinc
2130  f = reshape(utilities_forwardfield(timeinc,f_lastinc,fdot, & ! estimate of F at end of time+timeinc that matches rotated F_aim on average
2131  rotation_bc%rotate(f_aim,active=.true.)),&
2132  [9,grid(1),grid(2),grid3])
2133  if (guess) then
2134  f_tau = reshape(utilities_forwardfield(timeinc,f_tau_lastinc,f_taudot), &
2135  [9,grid(1),grid(2),grid3]) ! does not have any average value as boundary condition
2136  else
2137  do k = 1, grid3; do j = 1, grid(2); do i = 1, grid(1)
2138  f_lambda33 = reshape(f_tau(1:9,i,j,k)-f(1:9,i,j,k),[3,3])
2139  f_lambda33 = math_mul3333xx33(s_scale,matmul(f_lambda33, &
2140  math_mul3333xx33(c_scale,&
2141  matmul(transpose(f_lambda33),&
2142  f_lambda33)-math_i3))*0.5_preal) &
2143  + math_i3
2144  f_tau(1:9,i,j,k) = reshape(f_lambda33,[9])+f(1:9,i,j,k)
2145  enddo; enddo; enddo
2146  endif
2147 
2148  call dmdavecrestorearrayf90(da,solution_vec,fandf_tau,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
2149 
2150 end subroutine grid_mech_spectral_polarisation_forward
2151 
2152 
2153 !--------------------------------------------------------------------------------------------------
2155 !--------------------------------------------------------------------------------------------------
2156 subroutine grid_mech_spectral_polarisation_updatecoords
2157 
2158  integer(kind=selected_int_kind(5)) :: ierr
2159  real(kind=selected_real_kind(10)), dimension(:,:,:,:), pointer :: fandf_tau
2160 
2161  call dmdavecgetarrayf90(da,solution_vec,fandf_tau,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
2162  call utilities_updatecoords(fandf_tau(0:8,:,:,:))
2163  call dmdavecrestorearrayf90(da,solution_vec,fandf_tau,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
2164 
2165 end subroutine grid_mech_spectral_polarisation_updatecoords
2166 
2167 
2168 !--------------------------------------------------------------------------------------------------
2170 !--------------------------------------------------------------------------------------------------
2171 subroutine grid_mech_spectral_polarisation_restartwrite
2172 
2173  integer(kind=selected_int_kind(5)) :: ierr
2174  integer(HID_T) :: filehandle, grouphandle
2175  real(kind=selected_real_kind(10)), dimension(:,:,:,:), pointer :: fandf_tau, f, f_tau
2176  character(len=pStringLen) :: filename
2177 
2178  call dmdavecgetarrayf90(da,solution_vec,fandf_tau,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
2179  f => fandf_tau(0: 8,:,:,:)
2180  f_tau => fandf_tau(9:17,:,:,:)
2181 
2182  write(6,'(a)') ' writing solver data required for restart to file'; flush(6)
2183 
2184  write(filename,'(a,a,i0,a)') trim(getsolverjobname()),'_',worldrank,'.hdf5'
2185  filehandle = hdf5_openfile(filename,'w')
2186  grouphandle = hdf5_addgroup(filehandle,'solver')
2187 
2188  call hdf5_write(grouphandle,f_aim, 'F_aim')
2189  call hdf5_write(grouphandle,f_aim_lastinc,'F_aim_lastInc')
2190  call hdf5_write(grouphandle,f_aimdot, 'F_aimDot')
2191  call hdf5_write(grouphandle,f, 'F')
2192  call hdf5_write(grouphandle,f_lastinc, 'F_lastInc')
2193  call hdf5_write(grouphandle,f_tau, 'F_tau')
2194  call hdf5_write(grouphandle,f_tau_lastinc,'F_tau_lastInc')
2195 
2196  call hdf5_write(grouphandle,c_volavg, 'C_volAvg')
2197  call hdf5_write(grouphandle,c_volavglastinc,'C_volAvgLastInc')
2198 
2199  call hdf5_closegroup(grouphandle)
2200  call hdf5_closefile(filehandle)
2201 
2202  if(num%update_gamma) call utilities_savereferencestiffness
2203 
2204  call dmdavecrestorearrayf90(da,solution_vec,fandf_tau,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
2205 
2206 end subroutine grid_mech_spectral_polarisation_restartwrite
2207 
2208 
2209 !--------------------------------------------------------------------------------------------------
2211 !--------------------------------------------------------------------------------------------------
2212 subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dummy,ierr)
2213 
2214  type(tsnes) :: snes_local
2215  integer(kind=selected_int_kind(5)), intent(in) :: PETScIter
2216  real(kind=selected_real_kind(10)), intent(in) :: &
2217  devnull1, &
2218  devnull2, &
2219  devnull3
2220  integer(kind=selected_int_kind(5)) :: reason
2221  integer(kind=selected_int_kind(10)) :: dummy
2222  integer(kind=selected_int_kind(5)) :: ierr
2223  real(pReal) :: &
2224  curlTol, &
2225  divTol, &
2226  BCTol
2227 
2228  curltol = max(maxval(abs(f_aim-math_i3))*err_curl_tolrel ,err_curl_tolabs)
2229  divtol = max(maxval(abs(p_av)) *err_div_tolrel ,err_div_tolabs)
2230  bctol = max(maxval(abs(p_av)) *err_stress_tolrel,err_stress_tolabs)
2231 
2232  if ((totaliter >= itmin .and. &
2233  all([ err_div /divtol, &
2234  err_curl/curltol, &
2235  err_bc /bctol ] < 1.0_preal)) &
2236  .or. terminallyill) then
2237  reason = 1
2238  elseif (totaliter >= itmax) then
2239  reason = -1
2240  else
2241  reason = 0
2242  endif
2243 
2244 !--------------------------------------------------------------------------------------------------
2245 ! report
2246  write(6,'(1/,a)') ' ... reporting .............................................................'
2247  write(6,'(1/,a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', &
2248  err_div/divtol, ' (',err_div, ' / m, tol = ',divtol,')'
2249  write(6, '(a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', &
2250  err_curl/curltol,' (',err_curl,' -, tol = ',curltol,')'
2251  write(6, '(a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', &
2252  err_bc/bctol, ' (',err_bc, ' Pa, tol = ',bctol,')'
2253  write(6,'(/,a)') ' ==========================================================================='
2254  flush(6)
2255 
2256 end subroutine converged
2257 
2258 
2259 !--------------------------------------------------------------------------------------------------
2261 !--------------------------------------------------------------------------------------------------
2262 subroutine formresidual(in, FandF_tau, &
2263  residuum, dummy,ierr)
2264 
2265  integer(kind=selected_int_kind(5)), dimension(25) :: in
2266  real(kind=selected_real_kind(10)), dimension(3,3,2,in(13)+1:in(13)+in(16),in(14)+1:in(14)+in(17),in(15)+1:in(15)+in(18)), &
2267  target, intent(in) :: fandf_tau
2268  real(kind=selected_real_kind(10)), dimension(3,3,2,in(7)+1:in(7)+in(10),in(8)+1:in(8)+in(11),in(9)+1:in(9)+in(12)),&
2269  target, intent(out) :: residuum
2270  real(kind=selected_real_kind(10)), pointer, dimension(:,:,:,:,:) :: &
2271  f, &
2272  f_tau, &
2273  residual_f, &
2274  residual_f_tau
2275  integer(kind=selected_int_kind(5)) :: &
2276  PETScIter, &
2277  nfuncs
2278  integer(kind=selected_int_kind(10)) :: dummy
2279  integer(kind=selected_int_kind(5)) :: ierr
2280  integer :: &
2281  i, j, k, e
2282 
2283  f => fandf_tau(1:3,1:3,1,&
2284  in(13)+1:in(13)+in(16),in(14)+1:in(14)+in(17),in(15)+1:in(15)+in(18))
2285  f_tau => fandf_tau(1:3,1:3,2,&
2286  in(13)+1:in(13)+in(16),in(14)+1:in(14)+in(17),in(15)+1:in(15)+in(18))
2287  residual_f => residuum(1:3,1:3,1,&
2288  in(7)+1:in(7)+in(10), in(8)+1:in(8)+in(11), in(9)+1:in(9)+in(12))
2289  residual_f_tau => residuum(1:3,1:3,2,&
2290  in(7)+1:in(7)+in(10), in(8)+1:in(8)+in(11), in(9)+1:in(9)+in(12))
2291 
2292  f_av = sum(sum(sum(f,dim=5),dim=4),dim=3) * wgt
2293  call mpi_allreduce(mpi_in_place,f_av,9,mpi_double,mpi_sum,petsc_comm_world,ierr)
2294 
2295  call snesgetnumberfunctionevals(snes,nfuncs,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
2296  call snesgetiterationnumber(snes,petsciter,ierr); if (ierr .ne. 0) then;call petscerrorf(ierr);return;endif
2297 
2298  if (nfuncs == 0 .and. petsciter == 0) totaliter = -1 ! new increment
2299 !--------------------------------------------------------------------------------------------------
2300 ! begin of new iteration
2301  newiteration: if (totaliter <= petsciter) then
2302  totaliter = totaliter + 1
2303  write(6,'(1x,a,3(a,i0))') trim(incinfo), ' @ Iteration ', itmin, '≤',totaliter, '≤', itmax
2304  if (iand(debug_level(debug_spectral),debug_spectralrotation) /= 0) &
2305  write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
2306  ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(f_aim,active=.true.))
2307  write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
2308  ' deformation gradient aim =', transpose(f_aim)
2309  flush(6)
2310  endif newiteration
2311 
2312 !--------------------------------------------------------------------------------------------------
2313 !
2314  tensorfield_real = 0.0_preal
2315  do k = 1, grid3; do j = 1, grid(2); do i = 1, grid(1)
2316  tensorfield_real(1:3,1:3,i,j,k) = &
2317  polarbeta*math_mul3333xx33(c_scale,f(1:3,1:3,i,j,k) - math_i3) -&
2318  polaralpha*matmul(f(1:3,1:3,i,j,k), &
2319  math_mul3333xx33(c_scale,f_tau(1:3,1:3,i,j,k) - f(1:3,1:3,i,j,k) - math_i3))
2320  enddo; enddo; enddo
2321 
2322 !--------------------------------------------------------------------------------------------------
2323 ! doing convolution in Fourier space
2324  call utilities_ffttensorforward
2325  call utilities_fouriergammaconvolution(params%rotation_BC%rotate(polarbeta*f_aim,active=.true.))
2326  call utilities_ffttensorbackward
2327 
2328 !--------------------------------------------------------------------------------------------------
2329 ! constructing residual
2330  residual_f_tau = polarbeta*f - tensorfield_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3)
2331 
2332 !--------------------------------------------------------------------------------------------------
2333 ! evaluate constitutive response
2334  call utilities_constitutiveresponse(residual_f, & ! "residuum" gets field of first PK stress (to save memory)
2335  p_av,c_volavg,c_minmaxavg, &
2336  f - residual_f_tau/polarbeta,params%timeinc,params%rotation_BC)
2337  call mpi_allreduce(mpi_in_place,terminallyill,1,mpi_logical,mpi_lor,petsc_comm_world,ierr)
2338 
2339 !--------------------------------------------------------------------------------------------------
2340 ! stress BC handling
2341  f_aim = f_aim - math_mul3333xx33(s, ((p_av - params%stress_BC))) ! S = 0.0 for no bc
2342  err_bc = maxval(abs((1.0_preal-params%stress_mask) * math_mul3333xx33(c_scale,f_aim &
2343  -params%rotation_BC%rotate(f_av)) + &
2344  params%stress_mask * (p_av-params%stress_BC))) ! mask = 0.0 for no bc
2345 ! calculate divergence
2346  tensorfield_real = 0.0_preal
2347  tensorfield_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = residual_f
2348  call utilities_ffttensorforward
2349  err_div = utilities_divergencerms()
2350 
2351 !--------------------------------------------------------------------------------------------------
2352 ! constructing residual
2353  e = 0
2354  do k = 1, grid3; do j = 1, grid(2); do i = 1, grid(1)
2355  e = e + 1
2356  residual_f(1:3,1:3,i,j,k) = &
2357  math_mul3333xx33(math_invsym3333(materialpoint_dpdf(1:3,1:3,1:3,1:3,1,e) + c_scale), &
2358  residual_f(1:3,1:3,i,j,k) - matmul(f(1:3,1:3,i,j,k), &
2359  math_mul3333xx33(c_scale,f_tau(1:3,1:3,i,j,k) - f(1:3,1:3,i,j,k) - math_i3))) &
2360  + residual_f_tau(1:3,1:3,i,j,k)
2361  enddo; enddo; enddo
2362 
2363 !--------------------------------------------------------------------------------------------------
2364 ! calculating curl
2365  tensorfield_real = 0.0_preal
2366  tensorfield_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = f
2367  call utilities_ffttensorforward
2368  err_curl = utilities_curlrms()
2369 
2370 end subroutine formresidual
2371 
2372 end module grid_mech_spectral_polarisation
grid_mech_spectral_polarisation::c_minmaxavglastinc
real(preal), dimension(3, 3, 3, 3), private c_minmaxavglastinc
previous (min+max)/2 stiffness
Definition: grid_mech_spectral_polarisation.f90:1856
hdf5_utilities::hdf5_addgroup
integer(hid_t) function hdf5_addgroup(fileHandle, groupName)
adds a new group to the fileHandle
Definition: HDF5_utilities.f90:182
grid_mech_spectral_polarisation::s
real(preal), dimension(3, 3, 3, 3), private s
current compliance (filled up with zeros)
Definition: grid_mech_spectral_polarisation.f90:1856
rotations
rotation storage and conversion
Definition: rotations.f90:53
grid_mech_spectral_polarisation::grid_mech_spectral_polarisation_updatecoords
subroutine, public grid_mech_spectral_polarisation_updatecoords
Age.
Definition: grid_mech_spectral_polarisation.f90:2157
grid_mech_spectral_polarisation::f_aimdot
real(preal), dimension(3, 3), private f_aimdot
assumed rate of average deformation gradient
Definition: grid_mech_spectral_polarisation.f90:1848
homogenization::materialpoint_dpdf
real(preal), dimension(:,:,:,:,:,:), allocatable, public materialpoint_dpdf
tangent of first P–K stress at IP
Definition: homogenization.f90:40
grid_mech_spectral_polarisation::incinfo
character(len=pstringlen), private incinfo
time and increment information
Definition: grid_mech_spectral_polarisation.f90:1855
hdf5_utilities::hdf5_closegroup
subroutine hdf5_closegroup(group_id)
close a group
Definition: HDF5_utilities.f90:251
rotations::rotation
Definition: rotations.f90:63
grid_mech_spectral_polarisation::s_scale
real(preal), dimension(3, 3, 3, 3), private s_scale
Definition: grid_mech_spectral_polarisation.f90:1856
homogenization::materialpoint_f0
real(preal), dimension(:,:,:,:), allocatable, public materialpoint_f0
def grad of IP at start of FE increment
Definition: homogenization.f90:36
debug::debug_level
integer, dimension(debug_maxntype+2), public, protected debug_level
Definition: debug.f90:48
grid_mech_spectral_polarisation::grid_mech_spectral_polarisation_solution
type(tsolutionstate) function, public grid_mech_spectral_polarisation_solution(incInfoIn, timeinc, timeinc_old, stress_BC, rotation_BC)
solution for the Polarisation scheme with internal iterations
Definition: grid_mech_spectral_polarisation.f90:2009
grid_mech_spectral_polarisation::c_volavg
real(preal), dimension(3, 3, 3, 3), private c_volavg
current volume average stiffness
Definition: grid_mech_spectral_polarisation.f90:1856
grid_mech_spectral_polarisation::f_lastinc
real(preal), dimension(:,:,:,:,:), allocatable, private f_lastinc
field of previous compatible deformation gradients
Definition: grid_mech_spectral_polarisation.f90:1840
grid_mech_spectral_polarisation::c_minmaxavg
real(preal), dimension(3, 3, 3, 3), private c_minmaxavg
current (min+max)/2 stiffness
Definition: grid_mech_spectral_polarisation.f90:1856
hdf5_utilities
Definition: HDF5_utilities.f90:11
hdf5_utilities::hdf5_openfile
integer(hid_t) function hdf5_openfile(fileName, mode, parallel)
open and initializes HDF5 output file
Definition: HDF5_utilities.f90:119
grid_mech_spectral_polarisation::f_aim_lastinc
real(preal), dimension(3, 3), private f_aim_lastinc
previous average deformation gradient
Definition: grid_mech_spectral_polarisation.f90:1848
spectral_utilities::tsolutionparams
Definition: spectral_utilities.f90:1557
spectral_utilities
Utilities used by the different spectral solver variants.
Definition: spectral_utilities.f90:10
grid_mech_spectral_polarisation::c_volavglastinc
real(preal), dimension(3, 3, 3, 3), private c_volavglastinc
previous volume average stiffness
Definition: grid_mech_spectral_polarisation.f90:1856
grid_mech_spectral_polarisation
Grid solver for mechanics: 1 Polarisation.
Definition: grid_mech_spectral_polarisation.f90:11
numerics::worldsize
integer, public, protected worldsize
MPI worldsize (/=1 for MPI simulations only)
Definition: numerics.f90:1470
grid_mech_spectral_polarisation::fdot
real(preal), dimension(:,:,:,:,:), allocatable, private fdot
field of assumed rate of compatible deformation gradient
Definition: grid_mech_spectral_polarisation.f90:1840
spectral_utilities::utilities_divergencerms
real(preal) function, public utilities_divergencerms()
calculate root mean square of divergence of field_fourier
Definition: spectral_utilities.f90:2031
config
Reads in the material configuration from file.
Definition: config.f90:13
discretization_grid::grid3
integer, public, protected grid3
(local) grid in 3rd direction
Definition: discretization_grid.f90:1478
spectral_utilities::utilities_curlrms
real(preal) function, public utilities_curlrms()
calculate max of curl of field_fourier
Definition: spectral_utilities.f90:2074
discretization_grid
Parse geometry file to set up discretization and geometry for nonlocal model.
Definition: discretization_grid.f90:11
prec
setting precision for real and int type
Definition: prec.f90:13
math::math_mul3333xx33
pure real(preal) function, dimension(3, 3) math_mul3333xx33(A, B)
matrix double contraction 3333x33 = 33 (ijkl,kl)
Definition: math.f90:368
grid_mech_spectral_polarisation::snes
type(tsnes), private snes
Definition: grid_mech_spectral_polarisation.f90:1835
grid_mech_spectral_polarisation::num
type(tnumerics) num
Definition: grid_mech_spectral_polarisation.f90:1830
grid_mech_spectral_polarisation::params
type(tsolutionparams), private params
Definition: grid_mech_spectral_polarisation.f90:1824
spectral_utilities::utilities_savereferencestiffness
subroutine, public utilities_savereferencestiffness
Write out the current reference stiffness for restart.
Definition: spectral_utilities.f90:2548
spectral_utilities::utilities_ffttensorforward
subroutine, public utilities_ffttensorforward
forward FFT of data in field_real to field_fourier
Definition: spectral_utilities.f90:1882
grid_mech_spectral_polarisation::grid_mech_spectral_polarisation_forward
subroutine, public grid_mech_spectral_polarisation_forward(cutBack, guess, timeinc, timeinc_old, loadCaseTime, deformation_BC, stress_BC, rotation_BC)
forwarding routine
Definition: grid_mech_spectral_polarisation.f90:2070
grid_mech_spectral_polarisation::f_taudot
real(preal), dimension(:,:,:,:,:), allocatable, private f_taudot
field of assumed rate of incopatible deformation gradient
Definition: grid_mech_spectral_polarisation.f90:1840
hdf5_utilities::hdf5_read
reads integer or float data of defined shape from file ! ToDo: order of arguments wrong
Definition: HDF5_utilities.f90:29
homogenization
homogenization manager, organizing deformation partitioning and stress homogenization
Definition: homogenization.f90:11
prec::preal
integer, parameter preal
number with 15 significant digits, up to 1e+-307 (typically 64 bit)
Definition: prec.f90:20
grid_mech_spectral_polarisation::c_scale
real(preal), dimension(3, 3, 3, 3), private c_scale
Definition: grid_mech_spectral_polarisation.f90:1856
math::math_invsym3333
real(preal) function, dimension(3, 3, 3, 3) math_invsym3333(A)
Inversion of symmetriced 3x3x3x3 matrix.
Definition: math.f90:489
debug
Reading in and interpretating the debugging settings for the various modules.
Definition: debug.f90:12
grid_mech_spectral_polarisation::solution_vec
type(tvec), private solution_vec
Definition: grid_mech_spectral_polarisation.f90:1836
grid_mech_spectral_polarisation::f_tau_lastinc
real(preal), dimension(:,:,:,:,:), allocatable, private f_tau_lastinc
field of previous incompatible deformation gradient
Definition: grid_mech_spectral_polarisation.f90:1840
grid_mech_spectral_polarisation::err_div
real(preal), private err_div
RMS of div of P.
Definition: grid_mech_spectral_polarisation.f90:1865
spectral_utilities::utilities_fouriergammaconvolution
subroutine, public utilities_fouriergammaconvolution(fieldAim)
doing convolution gamma_hat * field_real, ensuring that average value = fieldAim
Definition: spectral_utilities.f90:1954
grid_mech_spectral_polarisation::formresidual
subroutine formresidual(in, FandF_tau, residuum, dummy, ierr)
forms the residual vector
Definition: grid_mech_spectral_polarisation.f90:2264
spectral_utilities::utilities_updatecoords
subroutine, public utilities_updatecoords(F)
calculate coordinates in current configuration for given defgrad field
Definition: spectral_utilities.f90:2447
grid_mech_spectral_polarisation::grid_mech_spectral_polarisation_restartwrite
subroutine, public grid_mech_spectral_polarisation_restartwrite
Write current solver and constitutive data for restart to file.
Definition: grid_mech_spectral_polarisation.f90:2172
spectral_utilities::utilities_forwardfield
real(preal) function, dimension(3, 3, grid(1), grid(2), grid3), public utilities_forwardfield(timeinc, field_lastInc, rate, aim)
forwards a field with a pointwise given rate, if aim is given, ensures that the average matches the a...
Definition: spectral_utilities.f90:2368
grid_mech_spectral_polarisation::converged
subroutine converged(snes_local, PETScIter, devNull1, devNull2, devNull3, reason, dummy, ierr)
convergence check
Definition: grid_mech_spectral_polarisation.f90:2213
grid_mech_spectral_polarisation::err_curl
real(preal), private err_curl
RMS of curl of F.
Definition: grid_mech_spectral_polarisation.f90:1865
numerics::itmax
integer, public, protected itmax
maximum number of iterations
Definition: numerics.f90:1495
spectral_utilities::utilities_constitutiveresponse
subroutine, public utilities_constitutiveresponse(P, P_av, C_volAvg, C_minmaxAvg, F, timeinc, rotation_BC)
calculate constitutive response from materialpoint_F0 to F during timeinc
Definition: spectral_utilities.f90:2266
grid_mech_spectral_polarisation::totaliter
integer, private totaliter
total iteration in current increment
Definition: grid_mech_spectral_polarisation.f90:1870
damask_interface::interface_restartinc
integer, public, protected interface_restartinc
Increment at which calculation starts.
Definition: DAMASK_interface.f90:36
damask_interface
Interfacing between the 1-based solvers and the material subroutines provided by DAMASK.
Definition: DAMASK_interface.f90:22
grid_mech_spectral_polarisation::p_av
real(preal), dimension(3, 3), private p_av
average 1st Piola–Kirchhoff stress
Definition: grid_mech_spectral_polarisation.f90:1848
config::config_numerics
type(tpartitionedstringlist), public, protected config_numerics
Definition: config.f90:30
spectral_utilities::tensorfield_real
real(c_double), dimension(:,:,:,:,:), pointer, public tensorfield_real
real representation (some stress or deformation) of field_fourier
Definition: spectral_utilities.f90:1497
debug::debug_spectral
integer, parameter, public debug_spectral
Definition: debug.f90:32
hdf5_utilities::hdf5_closefile
subroutine hdf5_closefile(fileHandle)
close the opened HDF5 output file
Definition: HDF5_utilities.f90:167
numerics::worldrank
integer, public, protected worldrank
MPI worldrank (/=0 for MPI simulations only)
Definition: numerics.f90:1470
math
Mathematical library, including random number generation and tensor representations.
Definition: math.f90:12
grid_mech_spectral_polarisation::f_aim
real(preal), dimension(3, 3), private f_aim
current prescribed deformation gradient
Definition: grid_mech_spectral_polarisation.f90:1848
fesolving::terminallyill
logical terminallyill
at least one material point is terminally ill
Definition: FEsolving.f90:15
spectral_utilities::wgt
real(preal), public, protected wgt
weighting factor 1/Nelems
Definition: spectral_utilities.f90:1490
discretization_grid::grid
integer, dimension(3), public, protected grid
(global) grid
Definition: discretization_grid.f90:1476
numerics::itmin
integer, public, protected itmin
minimum number of iterations
Definition: numerics.f90:1495
grid_mech_spectral_polarisation::err_bc
real(preal), private err_bc
deviation from stress BC
Definition: grid_mech_spectral_polarisation.f90:1865
debug::debug_spectralrotation
integer, parameter, public debug_spectralrotation
Definition: debug.f90:25
damask_interface::getsolverjobname
character(len=:) function, allocatable, public getsolverjobname()
solver job name (no extension) as combination of geometry and load case name
Definition: DAMASK_interface.f90:1737
spectral_utilities::utilities_maskedcompliance
real(preal) function, dimension(3, 3, 3, 3), public utilities_maskedcompliance(rot_BC, mask_stress, C)
calculates mask compliance tensor used to adjust F to fullfill stress BC
Definition: spectral_utilities.f90:2135
spectral_utilities::utilities_updategamma
subroutine, public utilities_updategamma(C)
updates reference stiffness and potentially precalculated gamma operator
Definition: spectral_utilities.f90:1841
spectral_utilities::tboundarycondition
set of parameters defining a boundary condition
Definition: spectral_utilities.f90:1537
numerics
Managing of parameters related to numerics.
Definition: numerics.f90:10
hdf5_utilities::hdf5_opengroup
integer(hid_t) function hdf5_opengroup(fileHandle, groupName)
open an existing group of a file
Definition: HDF5_utilities.f90:215
spectral_utilities::tsolutionstate
return type of solution from spectral solver variants
Definition: spectral_utilities.f90:1528
fesolving
global variables for flow control
Definition: FEsolving.f90:10
grid_mech_spectral_polarisation::tnumerics
Definition: grid_mech_spectral_polarisation.f90:1826
spectral_utilities::utilities_ffttensorbackward
subroutine, public utilities_ffttensorbackward
backward FFT of data in field_fourier to field_real
Definition: spectral_utilities.f90:1894
grid_mech_spectral_polarisation::f_av
real(preal), dimension(3, 3), private f_av
average incompatible def grad field
Definition: grid_mech_spectral_polarisation.f90:1848
spectral_utilities::utilities_calculaterate
pure real(preal) function, dimension(3, 3, grid(1), grid(2), grid3), public utilities_calculaterate(heterogeneous, field0, field, dt, avRate)
calculates forward rate, either guessing or just add delta/timeinc
Definition: spectral_utilities.f90:2341
grid_mech_spectral_polarisation::da
type(tdm), private da
Definition: grid_mech_spectral_polarisation.f90:1834
grid_mech_spectral_polarisation::grid_mech_spectral_polarisation_init
subroutine, public grid_mech_spectral_polarisation_init
allocates all necessary fields and fills them with data, potentially from restart info
Definition: grid_mech_spectral_polarisation.f90:1886
hdf5_utilities::hdf5_write
writes integer or real data of defined shape to file ! ToDo: order of arguments wrong
Definition: HDF5_utilities.f90:52
math::math_i3
real(preal), dimension(3, 3), parameter math_i3
3x3 Identity
Definition: math.f90:32