FORTRAN example for GetStringLength

 

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