1C $Header: /var/cvs/mbdyn/mbdyn/mbdyn-1.0/utils/test_strext_socket_f.f,v 1.9 2017/01/12 15:10:28 masarati Exp $ */
2C MBDyn (C) is a multibody analysis code.
3C http://www.mbdyn.org
4C
5C Copyright (C) 1996-2017
6C
7C Pierangelo Masarati	<masarati@aero.polimi.it>
8C Paolo Mantegazza	<mantegazza@aero.polimi.it>
9C
10C Dipartimento di Ingegneria Aerospaziale - Politecnico di Milano
11C via La Masa, 34 - 20156 Milano, Italy
12C http://www.aero.polimi.it
13C
14C Changing this copyright notice is forbidden.
15C
16C This program is free software; you can redistribute it and/or modify
17C it under the terms of the GNU General Public License as published by
18C the Free Software Foundation (version 2 of the License).
19C
20C
21C This program is distributed in the hope that it will be useful,
22C but WITHOUT ANY WARRANTY; without even the implied warranty of
23C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24C GNU General Public License for more details.
25C
26C You should have received a copy of the GNU General Public License
27C along with this program; if not, write to the Free Software
28C Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
29C
30C NOTE: this is all we use from MBDyn.  It was intentionally designed
31C to be configuration-independent.
32C
33C #include "mbc.h"
34
35      SUBROUTINE MAINF
36
37      IMPLICIT NONE
38
39      INTEGER*4 REFNODE, NODES, ROT, ITERS, VERB
40      INTEGER*4 STEPS, KEEPGOING, ITER, RC, I, J, N, CONVERGED
41      REAL*4 RF(3), RM(3), NF(3, 100), NM(3, 100)
42      REAL*4 RX(3), RR(3, 3), RTHETA(3), RXP(3), ROMEGA(3),
43     & NX(3, 100), NR(3, 3, 100), NTHETA(3, 100),
44     & NXP(3, 100), NOMEGA(3, 100)
45
46      EQUIVALENCE(RR(1, 1), RTHETA(1))
47      EQUIVALENCE(NR(1, 1, 1), NTHETA(1, 1))
48
49      CALL TDATA(REFNODE, NODES, ROT, ITERS, VERB, RC)
50      IF (NODES .GT. 100) THEN
51        WRITE(*, *) 'NODES=',NODES,' exceeds max (100)'
52        STOP
53      ENDIF
54
55      KEEPGOING = 1
56      STEPS = 0
57      DO WHILE (KEEPGOING .EQ. 1)
58        CONVERGED = 0
59        DO ITER = 1,ITERS
60          CALL TRECV(RX, RR, RXP, ROMEGA, NX, NR, NXP, NOMEGA, RC)
61          IF (RC .NE. 0) THEN
62            WRITE (*, *) 'recv failed'
63            STOP
64          ENDIF
65
66          IF (VERB .NE. 0) THEN
67            IF (REFNODE .NE. 0) THEN
68              WRITE (*, *) 'reference node:'
69              WRITE (*, *) 'x=', (RX(I), I=1,3)
70              IF (ROT .EQ. 0) THEN
71                WRITE (*, *) 'R=', (RR(I,J), I,J = 1,3)
72              ELSEIF (ROT .EQ. 1) THEN
73                WRITE (*, *) 'THETA=', (RTHETA(I), I = 1,3)
74              ELSEIF (ROT .EQ. 2) THEN
75                WRITE (*, *) 'EULER123=', (RTHETA(I), I = 1,3)
76              ENDIF
77              WRITE (*, *) 'xp=', (RXP(I), I = 1,3)
78              WRITE (*, *) 'omega=', (ROMEGA(I), I = 1,3)
79            ENDIF
80
81            IF (NODES .GT. 0) THEN
82              DO N = 1,NODES
83                WRITE (*, *) 'node', N, ':'
84                WRITE (*, *) 'x=', (NX(I,N), I = 1,3)
85                IF (ROT .EQ. 0) THEN
86                  WRITE (*, *) 'R=', (NR(I,J,N), I,J = 1,3)
87                ELSEIF (ROT .EQ. 1) THEN
88                  WRITE (*, *) 'THETA=', (NTHETA(I, N), I = 1,3)
89                ELSEIF (ROT .EQ. 2) THEN
90                  WRITE (*, *) 'EULER123=', (NTHETA(I, N), I = 1,3)
91                ENDIF
92                WRITE (*, *) 'xp=', (NXP(I,N), I = 1,3)
93                WRITE (*, *) 'omega=', (NOMEGA(I,N), I = 1,3)
94              ENDDO
95            ENDIF
96          ENDIF
97
98          CALL TFORCE(RF, RM, NF, NM)
99          IF (ITER .EQ. ITERS) THEN
100            CONVERGED = 1
101          ENDIF
102          CALL TSEND(RF, RM, NF, NM, CONVERGED, RC)
103          IF (RC .NE. 0) THEN
104            WRITE(*, *) 'send failed'
105            STOP
106          ENDIF
107        ENDDO
108      ENDDO
109      END SUBROUTINE
110