pkg/autodiff/add_prefix.F

f9d7cbfb72 Ou W*0001 #include "AUTODIFF_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: ADD_PREFIX
                0005 C     !INTERFACE:
                0006       SUBROUTINE ADD_PREFIX( prefix, actvarf, fname )
                0007
                0008 C     !DESCRIPTION: \bv
                0009 C     ==================================================================
                0010 C     SUBROUTINE ADD_PREFIX
                0011 C     ==================================================================
                0012 C     o Helper S/R to add 2 character prefix to file-name
                0013 C     started: ou.wang@jpl.nasa.gov 24-Aug-2022
                0014 C     ==================================================================
                0015 C     \ev
                0016
                0017 C     !USES:
                0018       IMPLICIT NONE
                0019
                0020 C     !INPUT/OUTPUT PARAMETERS:
                0021 C     prefix  :: (input)  2 character prefix to add
                0022 C     actvarf :: (input)  active-variable file-name
                0023 C     fname   :: (output) file-name with added prefix
                0024       CHARACTER*(2) prefix
                0025       CHARACTER*(*) actvarf
                0026       CHARACTER*(*) fname
                0027
                0028 C     !FUNCTIONS:
                0029       INTEGER  ILNBLNK
                0030       EXTERNAL ILNBLNK
                0031
                0032 C     !LOCAL VARIABLES:
de57a2ec4b Mart*0033       INTEGER il, ic, l
f9d7cbfb72 Ou W*0034 CEOP
                0035
                0036       il = ILNBLNK( actvarf )
de57a2ec4b Mart*0037       ic = 0
                0038       IF ( il .GT. 0 .AND. (il+2) .LE. LEN(fname) ) THEN
f9d7cbfb72 Ou W*0039         l = il
de57a2ec4b Mart*0040         DO WHILE ( ic .EQ. 0 .AND. l .GE. 1 )
                0041           IF ( actvarf(l:l) .EQ. '/' ) ic = l
f9d7cbfb72 Ou W*0042           l = l -1
                0043         ENDDO
                0044       ELSE
                0045         STOP 'ABNORMAL END: S/R ADD_PREFIX'
                0046       ENDIF
de57a2ec4b Mart*0047       WRITE(fname,'(3A)') actvarf(1:ic), prefix, actvarf(ic+1:il)
f9d7cbfb72 Ou W*0048
                0049       RETURN
                0050       END