Problem with migration from compaq compiler to intel compiler

perzo · ‎03-01-2010

HI

I have a problem running the Fortran 77 code compiled successfully on Abaqus 6.4-1. Now I want to run the same code on ABAQUS 6.9-1 with Intel compiler, and it is not possible. Intel compiles code successfully, but the variables do not match and the code stops working correctly. Do you have any idea why this happens. I enclose the code. Thanks for any comments.

perzo

!
!***********************************************************************
subroutine vumat(
* nblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal,
* stepTime, totalTime, dt, cmname, coordMp, charLength,
* props, density, strainInc, relSpinInc,
* tempOld, stretchOld, defgradOld, fieldOld,
* stressOld, stateOld, enerInternOld, enerInelasOld,
* tempNew, stretchNew, defgradNew, fieldNew,
! MODIFIABLE VARIABLES
* stressNew, stateNew, enerInternNew, enerInelasNew )
!***********************************************************************
INCLUDE 'vaba_param.inc'
C IMPLICIT REAL*8(A-H,O-Z)
CHARACTER*80 cmname
DIMENSION props(nprops), density(nblock), coordMp(nblock,*),
1 charLength(nblock), strainInc(nblock,ndir+nshr),
2 relSpinInc(nblock,nshr), tempOld(nblock),
3 stretchOld(nblock,ndir+nshr),
4 defgradOld(nblock,ndir+nshr+nshr),
5 fieldOld(nblock,nfieldv), stressOld(nblock,ndir+nshr),
6 stateOld(nblock,nstatev), enerInternOld(nblock),
7 enerInelasOld(nblock), tempNew(nblock),
8 stretchNew(nblock,ndir+nshr),
8 defgradNew(nblock,ndir+nshr+nshr),
9 fieldNew(nblock,nfieldv),
1 stressNew(nblock,ndir+nshr), stateNew(nblock,nstatev),
2 enerInternNew(nblock), enerInelasNew(nblock)
! MY VARIABLES
DIMENSION YSC(4), HNC(4)
DATA YSC, HNC /-4.280442672610864D-5, 1.042845507544633D-3,
* -2.903485082304501D-1, 4.527322673754001D+2,
* 7.560507877991158D-9, 2.452971393461358D-7,
* -1.888449502743490D-5, 5.771908698178631D-2/
LOGICAL*1 PH, ER, ALLDM /.FALSE./
CHARACTER*80 JOBNAME /'chbs'/
CHARACTER*80 OUTPATH /'C:\\CAFE\\results\'/
REAL*4 BFM, BFSTD, WBETAB, WETAB, WGAMB, GAMMAP, PART, MISOR,
* MAXMIS
INTEGER*1 CARBV
PARAMETER (NEL = 900, NC=5, NCB = 10, E = 2.D5, POISSON = .3D0,
* PH = .TRUE., ER = .FALSE., S1 = 5.D2, D = 3.D0, F0 = 1.D-4,
* BFM = 8.E0, BFSTD = 1.2E0,
! BF = 6.D0,
! * WBETAD = 2.E0, WETAD = 2.82094792E-4,
! * FSM = 2.4E3, FSSTD = 2.6E2,
* WBETAB = 1.223297115001437E0, WETAB = 5.391692185925237E0,
* WGAMB = 5.164210000000000E-1, GAMMAP = 5.2E1,

! WBETAB, WETAB AND WGAMB ARE BASED ON THE AVERAGED GRAIN SIZE
! DISTRIBUTION OF FOUR LABROLLED TMCR PLATES.

* DSCC = .2D0, BSCC = .4D0,
* PART = 5.E-3, CARBV = 1, MAXMIS = 7.E1)
PARAMETER (CEEQ = 0.816496580927726D0, CSEQ = 1.224744871391589D0,
* MDIR = 3, MSHR = 3)
LOGICAL*1 FIRST_CALL /.TRUE./, PLST(NEL), CRTIP, MIS
INTEGER*1 CS(NEL,NC,NC,NC), CSB(NEL,NCB,NCB,NCB),
* CSN(NC,NC,NC), CSBN(NCB,NCB,NCB)
INTEGER*2 UENUM
REAL*4 U(NEL,NC,NC,NC), UB(NEL,NCB,NCB,NCB), CLINI(NEL,4),
* OR(NEL,NCB,NCB,NCB)
DIMENSION STRESSINC(NDIR + NSHR),
* EET(NEL,MDIR + MSHR), EEQPT(NEL),
* BETAT(NEL), NAC(NEL), NACO(NEL),
* NACB(NEL), NDBC(NEL), NDDC(NEL), SCF(NC,NC,NC),
* SCFB(NCB,NCB,NCB), DE(NDIR+NSHR), X(3),
* SEQO(NEL), SEQP(NEL), SEQFEO(NEL)
! ALLOCATABLE :: CLINI(:,:)
DATA INDEX /0/
!***********************************************************************
IF (INDEX .EQ. NEL) GOTO 1200
IF (INDEX .NE. 0) GOTO 1000
YSTRESS = YSC(1)*PROPS(1)*PROPS(1)*PROPS(1) +
* YSC(2)*PROPS(1)*PROPS(1) + YSC(3)*PROPS(1) + YSC(4)
HN = HNC(1)*PROPS(1)*PROPS(1)*PROPS(1) +
* HNC(2)*PROPS(1)*PROPS(1) + HNC(3)*PROPS(1) + HNC(4)
INCNUM = 0
EET = 0.D0
EEQPT = 0.D0
BETAT = 0.D0
SEQP = 0.D0
PLST = .FALSE.
CS = -1
NAC = NC*NC*NC
NACO = NAC
INAC = NC*NC*NC
CAFD = NC*NC
CSB = -1
CALL KCARB(NEL,NCB,CSB,PART,CARBV)
NACB = NCB*NCB*NCB
INACB = NCB*NCB*NCB
CAFDB = NCB*NCB
NDBC = 0
NDDC = 0
DBVR = (REAL(NCB)/REAL(NC))**3
NAL = NEL
UENUM = 0
OUTINC = PROPS(2)/PROPS(3)
MISOR = PROPS(4)
BRFR = 0.D0
! GFF = GFF0 * (GFFC(1)*PROPS(1) + GFFC(2))
! GFF = GFF0
CALL KINIS(E,POISSON,C2G,CLAME)
!***********************************************************************
1000 DO 1100 LOOP=1,NBLOCK
CALL KS(NDIR,NSHR,C2G,CLAME,STRAININC(LOOP,:),STRESSINC)
STRESSNEW(LOOP,:) = STRESSOLD(LOOP,:) + STRESSINC
STATENEW(LOOP,2) = LOOP + INDEX
CLINI(LOOP + INDEX,1:3) = coordMp(LOOP,1:3)
1100 CLINI(LOOP + INDEX,4) = charLength(LOOP)
INDEX = INDEX + NBLOCK
IF (INDEX .NE. NEL) GOTO 1150
INCNUM = 1
1150 GOTO 2700
!***********************************************************************
1200 IF (.NOT. FIRST_CALL) GOTO 1300
TIME_PREV = TOTALTIME
FIRST_CALL = .FALSE.
CALL KINID(E,POISSON,YSTRESS,OUTPATH,JOBNAME,REAL(PROPS(1)),MISOR,
* C2G,C3G,CLAME,C3K)
! CALL KECG(JOBNAME,OUTPATH,NEL,'D',NC,CLINI)
CALL KECG(JOBNAME,OUTPATH,NEL,'B',NCB,CLINI)
CALL KU(NEL,NC,'D',BFSTD,BFM,0.E0,0.D0,0.D0,0.E0,OUTPATH,JOBNAME,
* U)
CALL KU(NEL,NCB,'B',WBETAB,WETAB,WGAMB,E,POISSON,GAMMAP,OUTPATH,
* JOBNAME,UB)
CALL KOR(NEL,NCB,MAXMIS,OR)
1300 STATENEW = STATEOLD
IF (NAL .NE. 0) GOTO 1500
IF (ALLDM) GOTO 1400
WRITE(103,*)'ALL FE ARE DESTROYED, INCNUM',INCNUM
ALLDM = .TRUE.
1400 STRESSNEW(:,:) = 0.D0
GOTO 2700
1500 IF (TOTALTIME .EQ. TIME_PREV) GOTO 1600
IF (TOTALTIME.LT.UENUM*OUTINC) GOTO 1550
UENUM = UENUM + 1
! CALL KUE(JOBNAME,OUTPATH,'D',TOTALTIME,UENUM,NEL,NC,CS)
CALL KUE(JOBNAME,OUTPATH,'B',TOTALTIME,UENUM,NEL,NCB,CSB)
IF (NAL.LT.NEL) WRITE(104,*)TOTALTIME,BRFR/DBLE(NEL-NAL)
1550 INCNUM = INCNUM + 1
TIME_PREV = TOTALTIME
!***********************************************************************
! MAIN LOOP (FE)
1600 DO 2600 LOOP=1,NBLOCK
MPN = NINT(STATEOLD(LOOP,2))
IF (NINT(STATEOLD(LOOP,1)) .NE. 0) GOTO 1700
STRESSNEW(LOOP,:) = 0.D0
GOTO 2600
1700 SCF = 1.D0
SCFB = 1.D0
CALL KEQM(NDIR,NSHR,CEEQ,STRAININC(LOOP,:),DEEQ,X(1))
STATENEW(LOOP,5) = DEEQ/DT
YS = YSTRESS
IF (ER) CALL KYS(YS,STATENEW(LOOP,5))
HARD1 = YS / C3G
! ELASTIC PART
IF (PLST(MPN)) GOTO 1800
CALL KEQM(NDIR,NSHR,CSEQ,STRESSOLD(LOOP,:),X(1),SM)
SEQO(MPN) = YS - S1*F0*D*EXP(SM/S1)
1800 CALL KSD(NDIR,NSHR,C2G,CLAME,STRAININC(LOOP,:),STRESSINC)
STRESSNEW(LOOP,:) = STRESSOLD(LOOP,:) + STRESSINC
CALL KEQM(NDIR,NSHR,CSEQ,STRESSNEW(LOOP,:),SEQ,X(1))

IF (SEQ.GT.SEQO(MPN)) GOTO 1900
EET(MPN,:) = EET(MPN,:) + STRAININC(LOOP,:)
IF (SEQ.LE.SEQP(MPN)) STATENEW(LOOP,6) = STATENEW(LOOP,6) - 2*DEEQ
GOTO 2000

! PLASTIC PART
1900 PLST(MPN) = .TRUE.
CALL KD(INCNUM,NDIR,NSHR,C2G,C3G,CLAME,C3K,YS,S1,D,PH,HN,
* HARD1,F0,STRAININC(LOOP,:),EET(MPN,:),EEQPT(MPN),
* BETAT(MPN),STRESSNEW(LOOP,:))
CALL KEQM(NDIR,NSHR,CSEQ,STRESSNEW(LOOP,:),SEQO(MPN),X(1))

2000 STATENEW(LOOP,6) = STATENEW(LOOP,6) + DEEQ
SEQP(MPN) = SEQ

!***********************************************************************
! SUB LOOP (U) - DUCTILE CELLS
IF (NAC(MPN) .NE. INAC) CALL KSRD(STRESSOLD(LOOP,:),NC,
* CS(MPN,:,:,:),DSCC,BSCC,SCF)
DO 2100, I = 1,NC
DO 2100, J = 1,NC
DO 2100, K = 1,NC
IF (CS(MPN,I,J,K) .NE. -1 .OR.
* BETAT(MPN) .LT. DBLE(U(MPN,I,J,K))/SCF(I,J,K)) GOTO 2100

WRITE(103,*)'SCF',SCF(I,J,K),' BETAF',DBLE(U(MPN,I,J,K)),
* 'ACTUAL BETAF',DBLE(U(MPN,I,J,K))/SCF(I,J,K)

CS(MPN,I,J,K) = 0
NAC(MPN) = NAC(MPN) - 1
WRITE(103,*)'D-INCNUM',INCNUM,' MPN',MPN,' I',I,' J',J,
* ' K',K,' NAC',NAC(MPN)
2100 CONTINUE

IF (NDBC(MPN).NE.0 .AND. NDDC(MPN).NE.0)
* STATENEW(LOOP,4) = NDBC(MPN)/(NDBC(MPN)+NDDC(MPN)*DBVR)

IF (NAC(MPN).EQ.NACO(MPN)) GOTO 2200
NDDC(MPN) = NDDC(MPN) + NACO(MPN) - NAC(MPN)
WRITE(103,*)'NDDC',NDDC(MPN)

! END OF SUB LOOP (U) - DUCTILE CELLS
!***********************************************************************
! SUB LOOP (UB) - BRITTLE CELLS

2200 CALL KMEL(NC,CS(MPN,:,:,:),NCB,CSBN)
CSB(MPN,:,:,:) = CSB(MPN,:,:,:) + ABS(CSB(MPN,:,:,:) -
* 2*INT(CSB(MPN,:,:,:)/2))*(CSBN+1)*(-CSB(MPN,:,:,:))
NTMP = SUM(INT(ABS(CSB(MPN,:,:,:)) - 2*INT(CSB(MPN,:,:,:)/2),2))
IF (NTMP .LT. NACB(MPN)) WRITE(103,*)'BD-INCNUM',INCNUM,' MPN',
* MPN,' KILLED',NACB(MPN)-NTMP,' B CELLS',' NACB',NTMP
NACB(MPN) = NTMP
IF (NACB(MPN) .NE. INACB) CALL KSRD(STRESSOLD(LOOP,:),NCB,
* CSB(MPN,:,:,:),DSCC,BSCC,SCFB)
CALL KDC(STRESSOLD(LOOP,:),X,SP1)
DO 2300, I = 1,NCB
DO 2300, J = 1,NCB
DO 2300, K = 1,NCB
IF (MOD(CSB(MPN,I,J,K),2).EQ.0) GOTO 2300
IF (SP1*SCFB(I,J,K) .LT. DBLE(UB(MPN,I,J,K))) GOTO 2300
CALL KMIS(NEL,NCB,CSB,MPN,I,J,K,OR,MISOR,MIS)
IF (CSB(MPN,I,J,K).NE.CARBV .AND. MIS) GOTO 2300

WRITE(103,*)'SCFB',SCFB(I,J,K),' SP1',SP1,'ACTING STRESS',SP1*
* SCFB(I,J,K)

CSB(MPN,I,J,K) = 2
NACB(MPN) = NACB(MPN) - 1
WRITE(103,*)'B-INCNUM',INCNUM,' MPN',MPN,' I',I,' J',J,' K',K,
* ' NACB',NACB(MPN)
2300 CONTINUE
IF (NACB(MPN) .EQ. NTMP) GOTO 2400
NDBC(MPN) = NDBC(MPN) + NTMP - NACB(MPN)
WRITE(103,*)'NDBC',NDBC(MPN)
STATENEW(LOOP,4) = NDBC(MPN)/(NDBC(MPN)+NDDC(MPN)*DBVR)
2400 CALL KMCL(NCB,CSB(MPN,:,:,:),NC,CSN)
! END OF SUB LOOP (UB) - BRITTLE CELLS
!***********************************************************************
CS(MPN,:,:,:) = -CS(MPN,:,:,:)*CSN
NACO(MPN) = -SUM(INT(CS(MPN,:,:,:),2))
IF (NACO(MPN) .EQ. NAC(MPN)) GOTO 2500
WRITE(103,*)'DB-INCNUM',INCNUM,
* ' MPN',MPN,' KILLED',NAC(MPN)-NACO(MPN),' D CELLS',
* ' NAC',NACO(MPN)
NAC(MPN) = NACO(MPN)

2500 STATENEW(LOOP,3) = 1.D0 - NDDC(MPN)/CAFD - NDBC(MPN)/CAFDB

!2500 STATENEW(LOOP,3) = MIN((CAFD - NDDC(MPN))/CAFD,
! * (CAFDB - NDBC(MPN))/CAFDB)

IF (STATENEW(LOOP,3) .GT. 0.D0) GOTO 2600
NAL = NAL - 1
WRITE(103,*)'INCNUM',INCNUM,' MPN',MPN,' XXX',' NAL',NAL
STATENEW(LOOP,3) = 0.D0
STATENEW(LOOP,1) = 0.D0
STRESSNEW(LOOP,:) = 0.D0
BRFR = BRFR + STATENEW(LOOP,4)
2600 CONTINUE
!END OF MAIN LOOP
!***********************************************************************
2700 END SUBROUTINE VUMAT

SUBROUTINE KD(INCNUM,NDIR,NSHR,C2G,C3G,CLAME,C3K,YS,S1,D,PH,HN,
* HARD1,F0,DE,EET,EEQPT,BETAT,S)
IMPLICIT REAL*8(A-H,O-Z)
PARAMETER (TOL = 1.D-17, MNI = 20, ST = 1.D-20, HC1 = 4.D2,
* CSEQ = 1.224744871391589D0)
DIMENSION EHAT(NDIR + NSHR), EET(NDIR + NSHR), DE(NDIR + NSHR),
* SE(NDIR + NSHR), SDE(NDIR + NSHR), S(NDIR + NSHR),
* DEP(NDIR + NSHR)
LOGICAL*1 PH
! LOGICAL*1 FOI
! FOI = .TRUE.

ITER = 1
EHAT = EET + DE
CALL KSD(NDIR, NSHR, C2G, CLAME, EHAT, SE)
CALL KEQM(NDIR,NSHR,CSEQ,SE,SEQE,SME)
SDE = SE
DO 1000 I=1,NDIR
1000 SDE(I) = SDE(I) - SME
DEMP = 0.D0
DEEQP = 0.D0
2000 EEQP = EEQPT + DEEQP
IF (PH) GOTO 3000
H = YS + HC1 * EEQP
DH = HC1
GOTO 4000
3000 HAUX = 1+EEQP/HARD1
IF (EEQP.LT.0.D0) WRITE(102,*)'NEGATIVE EEQP',EEQP,' INCNUM',
* INCNUM
IF (HAUX.LT.0.D0) WRITE(102,*)'FUCK IN _KD_, NEGATIVE HAUX',HAUX,
* ' INCNUM',INCNUM
H = YS*HAUX**HN
DH = H*HN/(HAUX*HARD1)
4000 SM = SME - C3K*DEMP
SEQ = SEQE - C3G*DEEQP
CALL KBI(INCNUM, F0, S1, D, SM, BETAT, DEEQP, DBETA)
BETA = BETAT + DBETA
FZEB = F0 * EXP(BETA)
FZEB1 = 1-F0+FZEB
RHO = 1/FZEB1
B = S1*FZEB/FZEB1
DBDBE = B*(1-F0)/FZEB1
ESR = EXP(SM/(RHO*S1))
DESR = D*ESR
DBM = -C3K*DEEQP*DESR / (RHO*(S1-DEEQP*DESR*SM*FZEB))
DBEQ = DESR / (1-DEEQP*DESR*SM/S1*FZEB)
DXM = ESR*(DBDBE*DBM + B/S1*(-C3K/RHO + SM*FZEB*DBM))
DXEQ = ESR*(DBDBE*DBEQ + B/S1*SM*FZEB*DBEQ)
DFM = 1-D*DEEQP/(3*S1)*DXM
DFEQ = -D/(3*S1)*(B*ESR + DEEQP*DXEQ)
DGM = SEQ*FZEB*DBM + D*DXM
DGEQ = -C3G/RHO + SEQ*FZEB*DBEQ - DH + D*DXEQ
RF = -DEMP + DEEQP*B/(3*S1)*DESR
RG = -SEQ/RHO + H - B*DESR
DEN = DFM*DGEQ - DFEQ*DGM
CM = (DGEQ*RF - DFEQ*RG)/DEN
CEQ = (DFM*RG - DGM*RF)/DEN
DEMP = DEMP + CM
DEEQP = DEEQP + CEQ

! IF (((DEMP .LT. 0.) .OR. (DEEQP .LT. 0.)) .AND. FOI) THEN
! WRITE(102,*)'NEGATIVE INCREMENTS'
! WRITE(102,*)'DEMP',DEMP
! WRITE(102,*)'DEEQP',DEEQP
! FOI = .FALSE.
! ENDIF

ITER = ITER + 1
IF (ITER.LT.MNI) GOTO 5000
WRITE(102,*)'KD CANNOT CONVERGE, INCNUM',INCNUM
STOP
5000 IF ((ABS(CM) .GT. TOL) .OR. (ABS(CEQ) .GT. TOL)) GOTO 2000
SM = SME - C3K*DEMP
SEQ = SEQE - C3G*DEEQP
S = 0.D0
DEP = 0.D0
IF (SEQE .LT. ST) GOTO 6000
S = SEQ/SEQE*SDE
DEP = 1.5*SDE/SEQE*DEEQP
6000 DO 7000 I=1,NDIR
S(I) = S(I) + SM
7000 DEP(I) = DEP(I) + DEMP
EET = EET + DE - DEP
EEQPT = EEQPT + DEEQP
BETAT = BETAT + DBETA
END SUBROUTINE KD

SUBROUTINE KBI(INCNUM, F0, S1, D, SM, BETAT, DEEQP, DBETA)
IMPLICIT REAL*8(A-H,O-Z)
PARAMETER (TOL = 1D-14, MNI = 20)
I = 0
DBETA = 0.D0
1000 BETA = BETAT + DBETA
FZEB = F0*EXP(BETA)
Z = -DEEQP*D*EXP(SM/S1*(1-F0+FZEB))
CB = -(DBETA+Z) / (1+Z*SM/S1*FZEB)
DBETA = DBETA + CB
I = I + 1
IF (I .LT. MNI) GOTO 1100
WRITE(102,*)'KBI CANNOT CONVERGE, INCNUM',INCNUM
STOP
1100 IF (ABS(CB) .GT. TOL) GOTO 1000
END SUBROUTINE KBI

SUBROUTINE KINIS(E,POISSON,C2G,CLAME)
IMPLICIT REAL*4(A-H,O-Z)
C2G = 2.0 * E/(2.D0*(1.D0+POISSON))
CLAME = E*POISSON/((1.D0+POISSON)*(1.D0-2.D0*POISSON))
END SUBROUTINE KINIS

SUBROUTINE KINID(E,POISSON,YS,OUTPATH,JOBNAME,T,M,C2G,C3G,CLAME,
* C3K)
IMPLICIT REAL*8(A-H,O-Z)
REAL*4 T, M
INTEGER*1 ND
INTEGER*2 N, I, NTMP, CTI
CHARACTER*5 CT /''/, CM /''/
CHARACTER*80 FNAME
CHARACTER*80 OUTPATH
CHARACTER*80 JOBNAME
CHARACTER*1 SYMBOL
G = E/(2.D0*(1.D0+POISSON))
C2G = 2.D0*G
C3G = 3.D0*G
C3K = E/(1.D0-2.D0*POISSON)
CLAME = C3K*POISSON/(1.D0+POISSON)

NTMP = NINT(T)
CTI = 0
IF (NTMP.GE.0) GOTO 900
CTI = 1
CT(1:1) = '-'
NTMP = - NTMP
900 ND = 0
N = NTMP
1000 ND = ND + 1
N = N/10
IF (N .GE. 1) GOTO 1000
DO 1100 I=1,ND
SYMBOL = CHAR(INT(NTMP/(10**(ND-I))) + 48)
NTMP = NTMP - INT(NTMP/(10**(ND-I))) * (10**(ND-I))
1100 CT(I+CTI:I+CTI) = SYMBOL

NTMP = NINT(M)
ND = 0
N = NTMP
1200 ND = ND + 1
N = N/10
IF (N .GE. 1) GOTO 1200
DO 1300 I=1,ND
SYMBOL = CHAR(INT(NTMP/(10**(ND-I))) + 48)
NTMP = NTMP - INT(NTMP/(10**(ND-I))) * (10**(ND-I))
1300 CM(I:I) = SYMBOL

JOBNAME = JOBNAME(1:LEN_TRIM(JOBNAME))//'_t'//CT(1:LEN_TRIM(CT))//
* '_m'//CM(1:LEN_TRIM(CM))
FNAME = OUTPATH(1:LEN_TRIM(OUTPATH))//JOBNAME(1:LEN_TRIM(JOBNAME))
! ICOUNT = DELFILESQQ(FNAME(1:LEN_TRIM(FNAME))//'*')
OPEN(UNIT=101, FILE=FNAME(1:LEN_TRIM(FNAME))//'_out.o',
* STATUS='REPLACE')
OPEN(UNIT=102, FILE=FNAME(1:LEN_TRIM(FNAME))//'_err.o',
* STATUS='REPLACE')
OPEN(UNIT=103, FILE=FNAME(1:LEN_TRIM(FNAME))//'_del.o',
* STATUS='REPLACE')
OPEN(UNIT=104, FILE=FNAME(1:LEN_TRIM(FNAME))//'_br.o',
* STATUS='REPLACE')
WRITE(104,*)'TOTALTIME',' % BR FR FOR THE WHOLE MODEL'
WRITE(104,*)0.D0, 0.D0
END SUBROUTINE KINID

SUBROUTINE KU(NEL,NC,BD,C1,C2,C3,E,POISSON,GAMMAP,OUTPATH,JOBNAME,
* U)
USE NUMERICAL_LIBRARIES, ONLY: RNOPT,RNWIB,RNNOA

REAL*4 C1, C2, C3, U(NEL,NC,NC,NC), GAMMAP, TMP, PI
REAL*8 E, POISSON
PARAMETER (PI = 3.141592653589793E0)
INTEGER*4 N
CHARACTER*1 BD
CHARACTER*80 OUTPATH
CHARACTER*20 JOBNAME
N = INT(NEL,4)*INT(NC,4)*INT(NC,4)*INT(NC,4)
CALL RNOPT(7)! GFSR generator (see imsl.hlp)
IF (BD.EQ.'B') GOTO 100
CALL RNNOA(N,U)
U = U * C1
U = U + C2
GOTO 200
100 CALL RNWIB(N,C1,U)
U = U * C2
U = U + C3
OPEN(UNIT=106, FILE=OUTPATH(1:LEN_TRIM(OUTPATH))//
* JOBNAME(1:LEN_TRIM(JOBNAME))//'_'//'G'//'.o', FORM = 'BINARY',
* STATUS = 'REPLACE')
WRITE(106)U
CLOSE(106)
TMP = SQRT(PI * REAL(E) * GAMMAP / (1-REAL(POISSON)*
* REAL(POISSON)))
U = TMP / SQRT(U)
200 OPEN(UNIT=106, FILE=OUTPATH(1:LEN_TRIM(OUTPATH))//
* JOBNAME(1:LEN_TRIM(JOBNAME))//'_'//BD//'.o', FORM = 'BINARY',
* STATUS = 'REPLACE')
WRITE(106)U
CLOSE(106)
MMA = 1
IMA = 1
JMA = 1
KMA = 1
MMI = 1
IMI = 1
JMI = 1
KMI = 1
UMA = U(1,1,1,1)
UMI = U(1,1,1,1)
DO 1000 M=1,NEL
DO 1000 I=1,NC
DO 1000 J=1,NC
DO 1000 K=1,NC
IF (U(M,I,J,K) .GT. UMA) THEN
UMA = U(M,I,J,K)
MMA = M
IMA = I
JMA = J
KMA = K
ENDIF
IF (U(M,I,J,K) .LT. UMI) THEN
UMI = U(M,I,J,K)
MMI = M
IMI = I
JMI = J
KMI = K
ENDIF
1000 CONTINUE
OPEN(UNIT=106, FILE=OUTPATH(1:LEN_TRIM(OUTPATH))//JOBNAME(1:
* LEN_TRIM(JOBNAME))//'_'//BD//'stat.o', STATUS = 'REPLACE')
WRITE(106,*)'MAX',UMA,' AT MPN',MMA,' I',IMA,' J',JMA,' K',KMA
WRITE(106,*)'MIN',UMI,' AT MPN',MMI,' I',IMI,' J',JMI,' K',KMI
UM = SUM(U)/N
USTD = SQRT(SUM((U-UM)**2)/(N-1))
WRITE(106,*)'MEAN',UM
WRITE(106,*)'STD',USTD
CLOSE(106)
END SUBROUTINE KU

SUBROUTINE KS(NDIR, NSHR, C1, C2, E, S)
INCLUDE 'vaba_param.inc'
! IMPLICIT REAL*4(A-H,O-Z)
DIMENSION E(NDIR + NSHR), S(NDIR + NSHR)
TRACE = E(1) + E(2) + E(3)
S = C1 * E
DO 1000 I=1, NDIR
1000 S(I) = S(I) + C2 * TRACE
END SUBROUTINE KS

SUBROUTINE KSD(NDIR,NSHR,C1,C2,E,S)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION E(NDIR + NSHR), S(NDIR + NSHR)
TRACE = E(1) + E(2) + E(3)
S = C1 * E
DO 1000 I=1, NDIR
1000 S(I) = S(I) + C2 * TRACE
END SUBROUTINE KSD

SUBROUTINE KEQM(NDIR,NSHR,C,T,TEQ,TM)
IMPLICIT REAL*8(A-H,O-Z)
PARAMETER (ONETHIRD = 0.33333333333333333D0)
DIMENSION T(NDIR + NSHR), TD(NDIR + NSHR)
TM = ONETHIRD * (T(1) + T(2) + T(3))
TD = T
DO 1000 I=1,NDIR
1000 TD(I) = TD(I) - TM
TEQ = C * SQRT(TD(1)*TD(1) + TD(2)*TD(2) + TD(3)*TD(3) +
* 2.D0*(TD(4)*TD(4) + TD(5)*TD(5) + TD(6)*TD(6)))
END SUBROUTINE KEQM

SUBROUTINE KDC(T,DC,VM)
USE NUMERICAL_LIBRARIES, ONLY: DEVCSF
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION T(6),A(3,3),VAL(3),VEC(3,3),DC(3)
A(1,1) = T(1)
A(2,2) = T(2)
A(3,3) = T(3)
A(1,2) = T(4)
A(2,1) = T(4)
A(2,3) = T(5)
A(3,2) = T(5)
A(3,1) = T(6)
A(1,3) = T(6)
CALL DEVCSF(3,A,3,VAL,VEC,3)
DC = VEC(:,1)
VM = VAL(1)
DO 1000 I=2,3
IF (VAL(I) .GT. VM) THEN
VM = VAL(I)
DC = VEC(:,I)
ENDIF
1000 CONTINUE
END SUBROUTINE

SUBROUTINE KEC(DC,EC)
IMPLICIT REAL*8(A-H,O-Z)
LOGICAL*1 EC(13)
DIMENSION DC(3), C(13,3)
PARAMETER (C0 = 0.D0, C3 = 5.773502691896258D-1,
* C2 = 7.071067811865475D-1, C1 = 1.D0, CD = 2.751298542128104D-1)
DATA C/-C3,-C2,C3,C2,C1,C2,C3,C2,C3,C0,C0,C0,C0,
* C3,C2,-C3,C0,C0,C0,C3,C2,C3,C2,C0,C1,C2,
* C3,C0,C3,-C2,C0,C2,-C3,C0,C3,-C2,C1,C0,C2/
EC = .FALSE.
DO 1100 I=1,13
IF (ABS(DC(1)*C(I,1)+DC(2)*C(I,2)+DC(3)*C(I,3))-CD) 1000,1100,1100
1000 EC(I) = .TRUE.
1100 CONTINUE
END SUBROUTINE KEC

SUBROUTINE KSRD(T,NSIZEA,A,CFD,CFB,CFA)
IMPLICIT REAL*8(A-H,O-Z)
INTEGER*1 A(NSIZEA,NSIZEA,NSIZEA)
LOGICAL*1 EC(13)
DIMENSION T(6), CFA(NSIZEA,NSIZEA,NSIZEA), DC(3)
CFA = 1.D0
CALL KDC(T,DC,X)
CALL KEC(DC,EC)
DO 1000 I=1,NSIZEA
DO 1000 J=1,NSIZEA
DO 1000 K=1,NSIZEA
IF (MOD(A(I,J,K),2).NE.0) GOTO 1000
CF = CFD
IF (A(I,J,K).EQ.2) CF = CFB
IP = I-1
IN = I+1
JP = J-1
JN = J+1
KP = K-1
KN = K+1
IF (I .EQ. 1) IP = NSIZEA
IF (I .EQ. NSIZEA) IN = 1
IF (J .EQ. 1) JP = NSIZEA
IF (J .EQ. NSIZEA) JN = 1
IF (K .EQ. 1) KP = NSIZEA
IF (K .EQ. NSIZEA) KN = 1
CFA(IN,JP,KP) = CFA(IN,JP,KP) - EC(1)*CF
CFA(IP,JN,KN) = CFA(IP,JN,KN) - EC(1)*CF
CFA(IN,JP,K) = CFA(IN,JP,K) - EC(2)*CF
CFA(IP,JN,K) = CFA(IP,JN,K) - EC(2)*CF
CFA(IN,JP,KN) = CFA(IN,JP,KN) - EC(3)*CF
CFA(IP,JN,KP) = CFA(IP,JN,KP) - EC(3)*CF
CFA(IN,J,KP) = CFA(IN,J,KP) - EC(4)*CF
CFA(IP,J,KN) = CFA(IP,J,KN) - EC(4)*CF
CFA(IN,J,K) = CFA(IN,J,K) - EC(5)*CF
CFA(IP,J,K) = CFA(IP,J,K) - EC(5)*CF
CFA(IN,J,KN) = CFA(IN,J,KN) - EC(6)*CF
CFA(IP,J,KP) = CFA(IP,J,KP) - EC(6)*CF
CFA(IN,JN,KP) = CFA(IN,JN,KP) - EC(7)*CF
CFA(IP,JP,KN) = CFA(IP,JP,KN) - EC(7)*CF
CFA(IN,JN,K) = CFA(IN,JN,K) - EC(8)*CF
CFA(IP,JP,K) = CFA(IP,JP,K) - EC(8)*CF
CFA(IN,JN,KN) = CFA(IN,JN,KN) - EC(9)*CF
CFA(IP,JP,KP) = CFA(IP,JP,KP) - EC(9)*CF
CFA(I,JP,KN) = CFA(I,JP,KN) - EC(10)*CF
CFA(I,JN,KP) = CFA(I,JN,KP) - EC(10)*CF
CFA(I,J,KN) = CFA(I,J,KN) - EC(11)*CF
CFA(I,J,KP) = CFA(I,J,KP) - EC(11)*CF
CFA(I,JN,K) = CFA(I,JN,K) - EC(12)*CF
CFA(I,JP,K) = CFA(I,JP,K) - EC(12)*CF
CFA(I,JN,KN) = CFA(I,JN,KN) - EC(13)*CF
CFA(I,JP,KP) = CFA(I,JP,KP) - EC(13)*CF
1000 CONTINUE
CFAMAX = 0.D0
DO 2000 I=1,NSIZEA
DO 2000 J=1,NSIZEA
DO 2000 K=1,NSIZEA
2000 IF (MOD(A(I,J,K),2).NE.0 .AND. CFA(I,J,K).GT.CFAMAX)
* CFAMAX = CFA(I,J,K)
DO 3000 I=1,NSIZEA
DO 3000 J=1,NSIZEA
DO 3000 K=1,NSIZEA
3000 IF (MOD(A(I,J,K),2).EQ.0) CFA(I,J,K) = CFAMAX
CFA = CFA*NSIZEA**3/SUM(CFA)
END SUBROUTINE KSRD

SUBROUTINE KMCL(N,A,M,Z)
INTEGER*1 A(N,N,N), Z(M,M,M)
INTEGER*2 B(N,N,N), C(N,N,M), D(N,M,M), E(M,M,M)
B = -ABS(A - 2*INT(A/2))
X = REAL(N)/REAL(M)
DO 1000 K=1,N
DO 1000 J=1,N
DO 1000 I=1,M
JE = INT(I*X)
CE = I*X - JE
X1 = (I-1)*X
JS = INT(X1)+ 2
CS = 1 - X1 + JS-2
1000 C(K,J,I) = NINT((SUM(B(K,J,JS:JE)) + CS*B(K,J,JS-1) +
* CE*B(K,J,JE+1)) / (JE-JS+1+CS+CE))
DO 1100 K=1,N
DO 1100 J=1,M
DO 1100 I=1,M
JE = INT(I*X)
CE = I*X - JE
X1 = (I-1)*X
JS = INT(X1)+ 2
CS = 1 - X1 + JS-2
1100 D(K,I,J) = NINT((SUM(C(K,JS:JE,J)) + CS*C(K,JS-1,J) +
* CE*C(K,JE+1,J)) / (JE-JS+1+CS+CE))
DO 1200 K=1,M
DO 1200 J=1,M
DO 1200 I=1,M
JE = INT(I*X)
CE = I*X - JE
X1 = (I-1)*X
JS = INT(X1)+ 2
CS = 1 - X1 + JS-2
1200 E(I,K,J) = NINT((SUM(D(JS:JE,K,J)) + CS*D(JS-1,K,J) +
* CE*D(JE+1,K,J)) / (JE-JS+1+CS+CE))
Z = E
END SUBROUTINE KMCL

SUBROUTINE KMEL(N,A,M,Z)
PARAMETER (TOL = 1.E-5)
INTEGER*1 A(N,N,N), B(N,N,M), C(N,M,M), Z(M,M,M)
X = REAL(N)/REAL(M) - TOL*M
DO 1000 L=1,N
DO 1000 K=1,N
DO 1000 I=1,M
1000 B(L,K,I) = A(L,K,INT(I*X)+1)
DO 1100 L=1,N
DO 1100 K=1,M
DO 1100 I=1,M
1100 C(L,I,K) = B(L,INT(I*X)+1,K)
DO 1200 L=1,M
DO 1200 K=1,M
DO 1200 I=1,M
1200 Z(I,L,K) = C(INT(I*X)+1,L,K)
END SUBROUTINE KMEL

SUBROUTINE KECG(JOBNAME,OUTPATH,NEL,ARRTYPE,N,CLINI)

INTEGER*2 NEL, N
INTEGER*4 PART, NN
CHARACTER*80 OUTPATH, JOBNAME, STRING
CHARACTER*1 ARRTYPE
REAL*4 CLINI(NEL,4), SHRINK, DELTA
PARAMETER (SHRINK = 0.5D0)

NN = N + 1
! CASE FILE

OPEN(UNIT=201, FILE = OUTPATH(1:LEN_TRIM(OUTPATH))//
* JOBNAME(1:LEN_TRIM(JOBNAME))//'_'//ARRTYPE//'.case', FORM =
* 'FORMATTED', ACCESS = 'SEQUENTIAL', STATUS = 'REPLACE')
WRITE(201,*)'# Case File '//JOBNAME(1:LEN_TRIM(JOBNAME))//'_'//
* ARRTYPE//'.case'
WRITE(201,*)'# EnSight 7.4.1'
WRITE(201,*)
WRITE(201,*)'FORMAT'
WRITE(201,*)'type: ensight gold'
WRITE(201,*)
WRITE(201,*)'GEOMETRY'
WRITE(201,*)'model: '//
* JOBNAME(1:LEN_TRIM(JOBNAME))//'_'//ARRTYPE//'.geo'
WRITE(201,*)
WRITE(201,*)'VARIABLE'
WRITE(201,*)'scalar per element: 1 cellstate '//
* JOBNAME(1:LEN_TRIM(JOBNAME))//'_'//ARRTYPE//'*****.scl'
WRITE(201,*)
WRITE(201,*)'TIME'
WRITE(201,*)'time set: 1'
WRITE(201,*)'number of steps: 1 # !! Change this to the
* max *.scl file number'
WRITE(201,*)'filename start number: 1'
WRITE(201,*)'filename increment: 1'
WRITE(201,*)'time values:'
WRITE(201,*)'1 # !! delete this line before postprocessing'
CLOSE(201)

! GEOMETRY FILE

OPEN(UNIT=201, FILE = OUTPATH(1:LEN_TRIM(OUTPATH))//
* JOBNAME(1:LEN_TRIM(JOBNAME))//'_'//ARRTYPE//'.geo', FORM =
* 'UNFORMATTED', ACCESS = 'SEQUENTIAL', STATUS = 'REPLACE')

STRING = 'Fortran Binary'
WRITE(201)STRING
STRING = 'EnSight Model Geometry File '//
* JOBNAME(1:LEN_TRIM(JOBNAME))//ARRTYPE//'.geo'
WRITE(201)STRING
STRING = 'EnSight 7.4.1'
WRITE(201)STRING
STRING = 'node id off'
WRITE(201)STRING
STRING = 'element id off'
WRITE(201)STRING
DO 1000 PART = 1,NEL
STRING = 'part'
WRITE(201)STRING
WRITE(201)PART
STRING = 'MPN'
WRITE(201)STRING
STRING = 'block uniform'
WRITE(201)STRING
WRITE(201)NN, NN, NN
DELTA = CLINI(PART,4) / REAL(N) * SHRINK
1000 WRITE(201)CLINI(PART,1), CLINI(PART,2),
* CLINI(PART,3), DELTA, DELTA, DELTA
CLOSE(201)
END SUBROUTINE KECG

SUBROUTINE KUE(JOBNAME,OUTPATH,ARRTYPE,TIME,UENUM,NEL,N,CEST)

IMPLICIT INTEGER*2 (A-Z)
CHARACTER*80 OUTPATH, JOBNAME, STRING
CHARACTER*1 ARRTYPE
REAL*8 TIME
CHARACTER FNAME*5, CHT*5, SYMBOL*1
INTEGER*1 CEST(NEL,N,N,N), TMP(N,N,N)
INTEGER*4 PART

! ADD TIME TO THE CASE FILE

OPEN(UNIT=201, FILE = OUTPATH(1:LEN_TRIM(OUTPATH))//
* JOBNAME(1:LEN_TRIM(JOBNAME))//'_'//ARRTYPE//'.case', FORM =
* 'FORMATTED', ACCESS = 'APPEND', STATUS = 'OLD')
WRITE(201,*)REAL(TIME)
CLOSE(201)

! WRITE A *.scl file

FNUM = UENUM
FNAME = '00000'
ND = 0
NT = FNUM
1000 ND = ND + 1
NT = NT/10
IF (NT .GE. 1) GOTO 1000
DO 1100 I=1,ND
SYMBOL = CHAR(INT(FNUM/(10**(ND-I))) + 48)
FNUM = FNUM - INT(FNUM/(10**(ND-I))) * (10**(ND-I))
1100 CHT(I:I) = SYMBOL
FNAME(LEN(FNAME)-ND+1:LEN(FNAME)) = CHT

OPEN(UNIT=201, FILE = OUTPATH(1:LEN_TRIM(OUTPATH))//
* JOBNAME(1:LEN_TRIM(JOBNAME))//'_'//ARRTYPE//FNAME//'.scl', FORM =
* 'UNFORMATTED', ACCESS = 'SEQUENTIAL', STATUS = 'REPLACE')

STRING = 'cellstate'
WRITE(201)STRING
DO 2000 PART = 1, NEL
STRING = 'part'
WRITE(201)STRING
WRITE(201)PART
STRING = 'block'
WRITE(201)STRING
DO 1200 I=1,N
DO 1200 J=1,N
DO 1200 K=1,N
1200 TMP(K,J,I) = CEST(PART,I,J,K)
2000 WRITE(201)REAL(TMP)
CLOSE(201)

END SUBROUTINE KUE

SUBROUTINE KYS(YS,DEDT)
IMPLICIT REAL*8 (A-H,O-Z)
PARAMETER (C = 1.D-4)
YS = YS*(1+C*DEDT)
END SUBROUTINE KYS

SUBROUTINE KCARB(NEL,NCB,CSB,PART,CARBV)
IMPLICIT INTEGER*2(A-Z)
INTEGER*1 CSB(NEL,NCB,NCB,NCB), CARBV
REAL*4 PART,TOTNUM,TMP(4)
I = 1
TOTNUM = PART*REAL(NEL)*REAL(NCB)*REAL(NCB)*REAL(NCB)
100 CALL RANDOM_SEED
CALL RANDOM_NUMBER(TMP)
A = NINT(1 + TMP(1)*(NEL-1))
B = NINT(1 + TMP(2)*(NCB-1))
C = NINT(1 + TMP(3)*(NCB-1))
D = NINT(1 + TMP(4)*(NCB-1))
IF (CSB(A,B,C,D).EQ.CARBV) GOTO 200
CSB(A,B,C,D) = CARBV
I = I + 1
200 IF (I.LT.TOTNUM) GOTO 100
END SUBROUTINE KCARB

SUBROUTINE KOR(NEL,NCB,MAXMIS,OR)
IMPLICIT INTEGER*2 (A-Z)
REAL*4 MAXMIS, OR(NEL,NCB,NCB,NCB)
CALL RANDOM_SEED
CALL RANDOM_NUMBER(OR)
OR = OR * MAXMIS
END SUBROUTINE KOR

SUBROUTINE KMIS(NEL,NCB,CSB,MPN,IX,JX,KX,OR,MISOR,MIS)
IMPLICIT INTEGER*2 (A-Z)
INTEGER*1 CSB(NEL,NCB,NCB,NCB)
REAL*4 OR(NEL,NCB,NCB,NCB), MISOR
LOGICAL*1 MIS
MIS = .TRUE.

! WRITE(*,*)'IX',IX,'JX',JX,'KX',KX,OR(MPN,IX,JX,KX)

DO 1000 II = IX-1, IX+1
DO 1000 JJ = JX-1, JX+1
DO 1000 KK = KX-1, KX+1
I = II
J = JJ
K = KK
IF (I.LT.1) I = NCB
IF (I.GT.NCB) I = 1
IF (J.LT.1) J = NCB
IF (J.GT.NCB) J = 1
IF (K.LT.1) K = NCB
IF (K.GT.NCB) K = 1

! WRITE(*,*)'I',I,'J',J,'K',K,OR(MPN,I,J,K)

IF (I.EQ.IX .AND. J.EQ.JX .AND. K.EQ.KX) GOTO 1000
IF (MOD(CSB(MPN,I,J,K),2).NE.0) GOTO 1000
IF (ABS(OR(MPN,I,J,K)-OR(MPN,IX,JX,KX)).LT.MISOR) MIS = .FALSE.
1000 CONTINUE
END SUBROUTINE KMIS

TimP · ‎03-01-2010

I guess you refer to incompatible run-time library function calls. If your Abaqus libraries were built by CVF, or with ifort prior to version 8.0, they don't link with more recent ifort libraries. If they were built with ifort 8.0 or 8.1, they may not work with ifort 10.0 or later. The advice provided by the software vendor is given for a reason. If you are outside the limits of the vendor's support, this is not the place to overcome that.

GeekVampi · ‎01-13-2011

Hi,

when compiling with intel fortran use a compile time option /Gm.../Gm option is same is /iface:cvf...it tells the compiler to use compaq convention...I compile UMATs with this option to work...mine was also working with 6.5 or earlier...but when abaqus switched to intel fortran it stopped working...

if it still doesn't work...try commenting out 'include vba_param.inc'...