C---- SUB. AXIAL_FORCE : AXIAL(TRA,ROT) SUBROUTINE AXIAL_FORCE & (TIME,UPAR,NPAR,JFLAG,IFLAG,RESULT) C---- TO EXPORT * SUBROUTINE !DEC$ ATTRIBUTES DLLEXPORT,C::AXIAL_FORCE
C---- INCLUDE SYSTEM CALL implicit none INCLUDE 'SYSCAL.F'
C---- DEFINE VARIABLES C Parameter Information C time: Simulation time of RD/Solver C upar: Parameters defined by user C npar: Number of user parameters C jflag: When RD/Solver evaluates a Jacobian, the flag is true. C iflag: When RD/Solver initializes arrays, the flag is true. C result: Returned value
DOUBLE PRECISION TIME, UPAR(*) INTEGER NPAR LOGICAL JFLAG, IFLAG DOUBLE PRECISION RESULT[REFERENCE]
C---- USER STATEMENT
C---- LOCAL VARIABLE DEFINITIONS INTEGER MKID(3), ID DOUBLE PRECISION DISP, VALUE(1) LOGICAL ERRFLG
COMMON /Axial_Force_String/ fInitial
integer fInitial(2),nString(2) !character*256 pString(2),FileName(2) character*(256) pString(2) character*(256) FileName integer finish,idFile(2),iString,szString
C---- ASSIGN IMPACT PARAMETERS MKID(1) = INT(UPAR(1)) MKID(2) = INT(UPAR(2)) MKID(3) = INT(UPAR(3)) ID = INT(UPAR(4)) iString = INT(UPAR(5)) idFile(iString) = 800+iString
call getfinishflag( finish )
if(fInitial(iString) .eq. 0)then fInitial(iString) = 1 call getstringlength(iString,nString(iString),ERRFLG) szString = nString(iString) !allocate(pString(iString)(1:nString(iString)))
call getstring & (iString,pString(iString),nString(iString),ERRFLG) FileName = & pString(iString)(1:(szString-1))//'.txt'//char(0) open(idFile(iString),file=trim(FileName),MODE='WRITE') endif
if(fInitial(iString) .eq. 1)then call getstring & (iString,pString(iString),nString(iString),errflg) write(idFile(iString),*) pString(iString) endif
C---- CALL AUXILIARY SUBROUTINES FOR CALCULATIONS CALL SYSFNC('DX', MKID, 3, DISP, ERRFLG) CALL RD_AKISPL(DISP, 0, ID, 0, VALUE(1), ERRFLG)
C---- ASSIGN THE RETURNED VALUE RESULT = VALUE(1)
if(finish .eq. 1) then !deallocate(pString(iString)) close(idFile(iString)) endif
RETURN END |