C nis2franc - NISA to franc2d C Users of this translator program, nis2franc, should read the following. C Special note should be made regarding the number of commas in the material C data lines. Temperature dependant material data is in reality supported but C in my opinion the instructions required to make it work plus the manual C editing of the *.nis file make it more practical to enter the data in C franc2d itself. C It should also be stressed that "Neither ANSTO nor the authors of C this code assumes any responsible for any errors, damage or loss that may C occur due to or caused by the use of this program." Had to say that. C C COMPATABLE ELEMENTS C C 2D PLANE STRESS NKTP=1 NORDR=2,11 C 2D PLANE STRAIN NKTP=2 NORDR=2,11 C AXISYMMETRIC NKTP=3 NORDR=2,11 C C C ANALYSIS GROUPS CURRENTLY READ IN ARE C ELTYPE,RCTABLE,NODES,ELEMENTS,SPDISP,CFORCE C PRESSURES,BODYFORCE,LDCASE,MATERIAL,NDTEMPER C C MODEL SHOULD BE GENERATED USING GLOBAL CARTESIAN C CO-ORDINATE SYSTEM C ALL ELEMENTS SHOULD BE NISA ORDER 2 OR 11, ie With 8 OR 6 NODES C C ELEMENT & NODE NUMBERS MUST BE CONSECUTIVE WITHOUT GAPS. C THUS IN DISPLAY A NODE COMPACT OPERATION C SHOULD BE PERFORMED ON THE MODEL BEFORE MAKING THE NISA DECK AND C USING THIS PROGRAM. C C MATERIAL PROPERTIES MUST BE IN ASCENDING ORDER OF MATERIAL NUMBER C WITHOUT ANY GAPS. C C THE VALUES FOR FRACTURE TOUGHNESS AND ROTATION ANGLE BETA NEED TO C BE INPUT USING FRANC2D. C NOTE THAT ORTHOTROPIC MATERIAL VALUES CANNOT BE USED WITH C AXISYMETRIC ELEMENTS, ie NKTP=3. THE MATERIAL PROPERTIES WILL BE C TRUNCATED TO ISOTROPIC. C C Temperature dependence is not yet supported !!!!!!!!!!!!!!!!!!!!! C C Check that *MATERIAL CARD IN NISA HAS VALUES OR COMMAS FOR C COEFF 0 THROUGH 4 (KTEMP=1, & COEFFS0 -->COEFF4 AS ACTUAL MATERIAL C VALUES. (This is important as the program will not work without the C commas following the material data) C eg. EX , 1,0,6.80000E+04,,,,, will work C EX , 1,0,6.80000E+04, will not C C C C CHECK THAT *LDCASE IN NISA HAS A VALUE FOR STRESS FREE TEMPERATURE C IE ENTRY TSFRE C C PROGRAM NIS2FRANC Ver 0.5 C DON MERCER, AUGUST 22, 1997 C C Questions regarding this program can be directed to C Phil Bendeich at PBX@ANSTO.GOV.AU C************************************************************* C PROGRAM FOR TRANSLATING NISA INPUT FILES TO FRANC2D C INPUT FILES. FILE FORMAT IS ASCII. PROGRAM REQUIRES C THE NISAII, .nis, AND THE FRANC2D, ie .inp FILE NAMES C TO BE ENTERED WHEN REQUESTED. C C Neither ANSTO nor the authers of this code are responsible C for any errors, dammage or loss that may occurr due to the C use of this program. C It is recomended that anyone using this program should C satisfy themselves that it is working correctly and not C assume that it is bug free C************************************************************* C C COMPATABLE ELEMENTS C C 2D PLANE STRESS NKTP=1 NORDR=2,11 C 2D PLANE STRAIN NKTP=2 NORDR=2,11 C AXISYMMETRIC NKTP=3 NORDR=2,11 C C C ANALYSIS GROUPS CURRENTLY READ IN ARE C ELTYPE,RCTABLE,NODES,ELEMENTS,SPDISP,CFORCE C PRESSURES,BODYFORCE,LDCASE,MATERIAL,NDTEMPER C C MODEL SHOULD BE GENERATED USING GLOBAL CARTESIAN C CO-ORDINATE SYSTEM C ALL ELEMENTS SHOULD BE NISA ORDER 2 OR 11, ie With 8 OR 6 NODES C C ELEMENT & NODE NUMBERS MUST BE CONSECUTIVE WITHOUT GAPS. C THUS IN DISPLAY A NODE COMPACT OPERATION C SHOULD BE PERFORMED ON THE MODEL BEFORE MAKING THE NISA DECK AND C USING THIS PROGRAM. C C MATERIAL PROPERTIES MUST BE IN ASCENDING ORDER OF MATERIAL NUMBER C WITHOUT ANY GAPS. C C THE VALUES FOR FRACTURE TOUGHNESS AND ROTATION ANGLE BETA NEED TO C BE INPUT USING FRANC2D. C NOTE THAT ORTHOTROPIC MATERIAL VALUES CANNOT BE USED WITH C AXISYMETRIC ELEMENTS, ie NKTP=3. THE MATERIAL PROPERTIES WILL BE C TRUNCATED TO ISOTROPIC. C C Temperature dependence is not yet supported !!!!!!!!!!!!!!!!!!!!! C C Check that *MATERIAL CARD IN NISA HAS VALUES OR COMMAS FOR C COEFF 0 THROUGH 4 (KTEMP=1, & COEFFS0 -->COEFF4 AS ACTUAL MATERIAL C VALUES. (This is important as the program will not work without the C commas following the material data) C eg. EX , 1,0,6.80000E+04,,,,, will work C EX , 1,0,6.80000E+04, will not C C C C CHECK THAT *LDCASE IN NISA HAS A VALUE FOR STRESS FREE TEMPERATURE C IE ENTRY TSFRE C C C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C USES SCRATCH FILES fred1.fred1 and fred2.fred2. ANY EXISTING FILES WITH C THESES NAMES WILL BE OVERWRITTEN!!! C C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C C BASED ON THE NISMAP TRANSLATOR (PAYTEN - MERCER 1993) C C************************************************************* C************************************************************ C C DIMENSION INITIAL ARRAY STATEMENTS ******************************************************************* C DIMENSION ALL REMAINING ARRAYS AND VARIABLES C****************************************************************** C C ELEMENT TYPE DIMENSION NSRL(10),NKTP(10),NORDR(10) C RCTABLE DIMENSION RC(5,8) INTEGER IDRC,NUMRC,IFORM C NODES DIMENSION NODER(5000),X(5000),Y(5000),Z(5000) C ELEMENTS DIMENSION NELID2(5000),MATID(5000),NSRL2(5000),IDRC2(5000) DIMENSION NODE(5000,8),KISO(5000),IMAT(150),ICVAR(200,9) INTEGER NODE C C MATERIALS DIMENSION VALUE(200),EX(50),EY(50),EZ(50),AMODRIG(50) DIMENSION ANUXY(50),ANUXZ(50),ANUYZ(50),DENS(50),TEMP(50) DIMENSION MATNUM(200),ALPX(50),ALPY(50),ALPZ(50),ROTBETA(50) DIMENSION VALUE1(50),VALUE2(50),VALUE3(50),VALUE4(50) DIMENSION COEFF(50,4,5),TEMPTAB(50,4,5) DIMENSION TEMP0(50),TEMP1(50),TEMP2(50),TEMP3(50),TEMP4(50) DIMENSION MTYPE(100,4) CHARACTER*4 MABAL(200) C C NODAL TEMPERATURES DIMENSION TNVAL(5000),ITNODE(5000) CHARACTER*4 LABC INTEGER INTEMP C C SPDISP DIMENSION NODED(2000),DISP(2000),IFIXTYPE(2000) CHARACTER*4 LABEL(2000) INTEGER POS(200),NODED C C FORCE DIMENSION NODEA(2000),FORC(2000),FORCE(2000,3) CHARACTER*4 LABAL(2000) INTEGER NCLOAD C C PRESSURE DIMENSION NELID(2000),IDFACE(2000),UPRES(2000),IHIS(2000) INTEGER LPRES C C C NISAII GROUP TYPES AND DESCRIPTOR SIZE INTEGER ELTYPE,RCTABLE,ELEMENT INTEGER FOR,BOD,DIS INTEGER JUNKA,JUNKB,JUNKC,JUNKD C CHARACTER*60 TITLE CHARACTER*80 LINE CHARACTER BLANK C C CHARACTER*80 TIT1,TIT2 COMMON /GETIT/ LINE PRINT*,'NISAII-FRANC2D CONVERSION PROGRAM' PRINT*,'PREPARATION OF INPUT FILE REQUIRES USER INPUT' PRINT*,'ENTER NAME OF NISA INPUT FILE' READ(*,199) TIT1 PRINT*, 'ENTERED ',TIT1 C START PROCESSING NISA INPUT FILE C C************************************************************* C C UNIT 10 NISA ASCII READ FILE, ie A .nis FILE C UNIT 11 FRANC2D ASCII WRITE FILE, ie a .inp FILE FOR FRANC2D C C OPEN(UNIT=10,FILE=TIT1,STATUS='OLD') PRINT*,'ENTER NAME OF FRANC ANALYSIS FILE , IE filename.inp' READ(*,199) TIT2 199 FORMAT(A) OPEN(UNIT=11,FILE=TIT2) OPEN(UNIT=12,FILE='fred1.fred1') OPEN(UNIT=13,FILE='fred2.fred2') REWIND(UNIT=13) C C************************************************************ C PRINT*,'READING NISA INPUT FILE TO DETERMINE DESCRIPTOR' PRINT*,'SIZE AND ANALYSIS GROUP SIZE' C FIRST STRIP OUT ALL COMMENT CALL STRIP() C REWIND(UNIT=13) BLANK=' ' C C C FIRST FIND THE NUMBER OF ENTRIES IN EACH NISA GROUP C C 20 READ(13,65,END=5000) LINE 65 FORMAT(A80) 29 CONTINUE IF (LINE(1:7).EQ.'*ELTYPE'.OR.LINE(1:7).EQ.'*eltype')THEN CALL CNT(ELTYPE,LINE1) PRINT *,' NUMBER OF ELTYPE DATA GROUPS=',ELTYPE GOTO 29 END IF IF (LINE(1:8).EQ.'*RCTABLE'.OR.LINE(1:8).EQ.'*rctable')THEN CALL CNT(RCTABLE,LINE1) PRINT *,'NUMBER OF RCTABLE DATA LINES=',RCTABLE GOTO 29 END IF IF (LINE(1:6).EQ.'*NODES'.OR.LINE(1:6).EQ.'*nodes')THEN CALL CNT(NODES,LINE1) PRINT*,'NUMBER OF NODES=',NODES GOTO 29 END IF IF (LINE(1:9).EQ.'*ELEMENTS'.OR.LINE(1:9).EQ.'*elements')THEN CALL CNT(ELEMENT,LINE1) ELEMENT=ELEMENT/2 PRINT*,'NUMBER OF ELEMENTS=',ELEMENT GOTO 29 END IF IF(LINE(1:9).EQ.'*NDTEMPER'.OR.LINE(1:9).EQ.'*ndtemper') THEN INTEMP=0 CALL CNT(INTEMP,LINE1) PRINT*,'NUMBER OF NODAL TEMPERATURE LINES = ',INTEMP GOTO 29 END IF IF (LINE(1:7).EQ.'*SPDISP'.OR.LINE(1:7).EQ.'*spdisp')THEN DIS=0 CALL CNT(DIS,LINE1) PRINT*,'NUMBER OF DISPLACEMENTS EQUATIONS= ',DIS GOTO 29 END IF IF (LINE(1:7).EQ.'*CFORCE'.OR.LINE(1:7).EQ.'*cforce')THEN FOR=0 CALL CNT(FOR,LINE1) PRINT*,'NUMBER OF FORCE EQUATIONS= ',FOR GOTO 29 END IF IF (LINE(1:9).EQ.'*PRESSURE'.OR.LINE(1:8).EQ.'*pressure')THEN LPRES=0 CALL CNT(LPRES,LINE1) PRINT*,'NUMBER OF PRESSURE EQUATIONS= ',LPRES GOTO 29 END IF IF (LINE(1:6).EQ.'*BODYF'.OR.LINE(1:6).EQ.'*bodyf')THEN BOD=0 CALL CNT(BOD,LINE1) PRINT*,'NUMBER OF BODYFORCE EQUATIONS= ', BOD GOTO 29 END IF IF(LINE(1:9).EQ.'*MATERIAL'.OR.LINE(1:9).EQ.'*material') THEN MATS=0 CALL CNT(MATS,LINE1) PRINT*,'NUMBER OF MATERIAL LINES= ', MATS GOTO 29 END IF IF (LINE(1:8).EQ.'*ENDDATA'.OR.LINE(1:8).EQ.'*enddata') THEN PRINT*,'END OF NISA INPUT DECK' ELSE GOTO 20 END IF 5000 CONTINUE ***************************************************** C**************************************************** C REWIND UNIT 10 AND 13 TO BEGINNING OF FILE C**************************************************** REWIND(UNIT=10) REWIND(UNIT=13) C**************************************************** C C PROCESSING OF NISA INPUT FILE BEGINS C C**************************************************** C NVP=0 NDC=0 NCLOAD=0 DO 805 I=1,60 TITLE(I:I)=BLANK 805 CONTINUE PRINT*,'PROCESSING NISA INPUT FILE' 10 READ (13,65,END=5005) LINE C C LOOK FOR * C IF (LINE(1:1).NE.'*') THEN GOTO 10 END IF C C *TITLE C IF (LINE(1:6).EQ.'*TITLE'.OR.LINE(1:6).EQ.'*title')THEN READ(13,67) TITLE 67 FORMAT(A60) PRINT*,'NISA TITLE=',TITLE WRITE(11,67) TITLE GOTO 10 ELSE END IF C C *ELTYPE C IF (LINE(1:7).EQ.'*ELTYPE'.OR.LINE(1:7).EQ.'*eltype')THEN PRINT*,'ELTYPE' DO 4 I=1,ELTYPE READ(13,*) NSRL(I),NKTP(I),NORDR(I) 4 CONTINUE GOTO 10 ELSE END IF C C *RCTABLE C IF (LINE(1:8).EQ.'*RCTABLE'.OR.LINE(1:8).EQ.'*rctable')THEN PRINT*,'RCTABLE' NCARD=0 12 READ(13,*)IDRC,NUMRC,IFORM NCARD=NCARD+1 IF (IFORM.EQ.0)THEN ICARD=NUMRC/8 REM=MOD(NUMRC,8) IF(REM.GT.0) THEN ICARD=ICARD+1 END IF DO 56 JJ=1,ICARD READ(13,*)(RC(IDRC,J),J=1,8) NCARD=NCARD+1 56 CONTINUE IF(NCARD.EQ.RCTABLE) THEN GOTO 10 ELSE GOTO 12 END IF ELSE ICARD=NUMRC/4 REM=MOD(NUMRC,4) IF(REM.GT.0) THEN ICARD=ICARD+1 END IF DO 57 JJ=1,ICARD READ(13,*)(RC(IDRC,J),J=1,4) NCARD=NCARD+1 57 CONTINUE IF(NCARD.EQ.RCTABLE) THEN GOTO 10 ELSE GOTO 12 END IF END IF END IF C C *NODES C IF (LINE(1:6).EQ.'*NODES'.OR.LINE(1:6).EQ.'*nodes')THEN PRINT*,'NODES' DO 105 J=1,NODES READ(13,*)NODER(J),JUNKA,JUNKB,JUNKC,X(J), +Y(J),Z(J),JUNKD 105 CONTINUE GOTO 10 END IF C C C *ELEMENTS C IF (LINE(1:9).EQ.'*ELEMENTS'.OR.LINE(1:9).EQ.'*elements')THEN PRINT*,'ELEMENTS' DO 118 I=1,50 IMAT(I)=0 118 CONTINUE DO 110 I=1,ELEMENT ICVAR(I,1)=0 ICVAR(I,2)=0 READ(13,*)NELID2(I),MATID(I),NSRL2(I),IDRC2(I),KISO(I) IM=MATID(I) IMAT(IM)=1 II=NSRL2(I) JJ=NELID2(I) C C 2D ELEMENT C IF(NKTP(II).LE.3) THEN IF(NKTP(II).LE.2) THEN ITYP=1 ELSE ITYP=0 END IF IF(NORDR(II).EQ.2) THEN READ(13,*)(NODE(JJ,J),J=1,8) DO 301 J=1,8 NODE(I,J)=NODE(JJ,J) 301 CONTINUE ELSE READ(13,*)(NODE(JJ,J),J=1,6) DO 302 J=1,6 NODE(I,J)=NODE(JJ,J) 302 CONTINUE END IF END IF C 110 CONTINUE DO 307 I=1,ELEMENT 307 CONTINUE C ------------------------ C FIND NUMBER OF MATERIALS C ------------------------ MANN=0 DO 147 M=1,150 IF(IMAT(M).EQ.1) THEN MANN=MANN+1 IMAT(MANN)=M END IF 147 CONTINUE GOTO 10 END IF C C C *MATERIAL C NLOAD=0 IF (LINE(1:9).EQ.'*MATERIAL'.OR.LINE(1:9).EQ.'*material')THEN PRINT*,'MATERIAL' NLOAD=1 DO 740 I=1,MATS READ(13,65) LINE C C PUT A ' AT THE START OF THE LINE AS THE LABEL COMES FIRST C DO 7236 J=79,1,-1 JJ=J+1 LINE(JJ:JJ)=LINE(J:J) 7236 CONTINUE LINE(1:1)="'" C FIND POSITION OF FIRST COMMA, IE AFTER THE LABEL K=1 DO 7235 J=1,81 IF( LINE(J:J).EQ.',') THEN POS(K)=J K=K+1 END IF 7235 CONTINUE C SHUFFLE THINGS UP AND PUT IN SECOND ' K=POS(1)+1 DO 7237 JJ=79,K,-1 LL=JJ-1 LINE(JJ:JJ)=LINE(LL:LL) 7237 CONTINUE KK=K-1 LINE(KK:KK)="'" C WRITE TO AND THEN READ FROM SCRATCH FILE WRITE(12,*) (LINE(J:J),J=1,80) BACKSPACE (UNIT=12) BACKSPACE (UNIT=12) C READ(12,*,END=7226) (LINE(J:J),J=1,80) READ(12,*,END=7226) MABAL(I),MATNUM(I),TEMP(I),VALUE(I), +VALUE1(I),VALUE2(I),VALUE3(I),VALUE4(I) TEMP0(I) = 0.0 TEMP1(I) = TEMP(I) TEMP2(I) = TEMP1(I)+TEMP(I) TEMP3(I) = TEMP2(I)+TEMP(I) TEMP4(I) = TEMP3(I)+TEMP(I) 740 CONTINUE 7226 CONTINUE DO 7181 J=1,MANN EX(J)=0. EY(J)=0. EZ(J)=0. ANUXY(J)=0. ANUXZ(J)=0. ANUYZ(J)=0. DENS(J)=0. ALPX(J)=0. ALPY(J)=0. ALPZ(J)=0. AMODRIG(J)=0. MTYPE(J,1)=0 MTYPE(J,2)=0 MTYPE(J,4)=0 7181 CONTINUE print*,mats DO 7114 I=1,MATS III=MATNUM(I) print*,mabal(I) IF (MABAL(I).EQ.'EX')THEN EX(III)=VALUE(I) IF(TEMP(I).GE.1)THEN MTYPE(III,1)=1 print*,'EX',I,iii COEFF(III,1,1)=VALUE(I) COEFF(III,1,2)=VALUE1(I) COEFF(III,1,3)=VALUE2(I) COEFF(III,1,4)=VALUE3(I) COEFF(III,1,5)=VALUE4(I) TEMPTAB(III,1,1)=TEMP0(I) TEMPTAB(III,1,2)=TEMP1(I) TEMPTAB(III,1,3)=TEMP2(I) TEMPTAB(III,1,4)=TEMP3(I) TEMPTAB(III,1,5)=TEMP4(I) END IF END IF IF (MABAL(I).EQ.'EY')THEN EY(III)=VALUE(I) END IF IF (MABAL(I).EQ.'EZ')THEN EZ(III)=VALUE(I) END IF IF (MABAL(I).EQ.'NUXY')THEN ANUXY(III)=VALUE(I) print*,'NUXY',value(I),temp1(i) IF(TEMP(I).GE.1)THEN MTYPE(III,2)=1 print*,'NUXY',I,iii COEFF(III,2,1)=VALUE(I) COEFF(III,2,2)=VALUE1(I) COEFF(III,2,3)=VALUE2(I) COEFF(III,2,4)=VALUE3(I) COEFF(III,2,5)=VALUE4(I) TEMPTAB(III,2,1)=TEMP0(I) TEMPTAB(III,2,2)=TEMP1(I) TEMPTAB(III,2,3)=TEMP2(I) TEMPTAB(III,2,4)=TEMP3(I) TEMPTAB(III,2,5)=TEMP4(I) END IF END IF IF (MABAL(I).EQ.'NUXZ')THEN ANUXZ(III)=VALUE(I) END IF IF (MABAL(I).EQ.'NUYZ')THEN ANUYZ(III)=VALUE(I) END IF IF (MABAL(I).EQ.'DENS')THEN DENS(III)=VALUE(I) END IF IF (MABAL(I).EQ.'ALPX')THEN ALPX(III)=VALUE(I) IF(TEMP(I).GE.1)THEN MTYPE(III,4)=1 print*,'ALPHX',I,iii COEFF(III,4,1)=VALUE(I) COEFF(III,4,2)=VALUE1(I) COEFF(III,4,3)=VALUE2(I) COEFF(III,4,4)=VALUE3(I) COEFF(III,4,5)=VALUE4(I) TEMPTAB(III,4,1)=TEMP0(I) TEMPTAB(III,4,2)=TEMP1(I) TEMPTAB(III,4,3)=TEMP2(I) TEMPTAB(III,4,4)=TEMP3(I) TEMPTAB(III,4,5)=TEMP4(I) END IF END IF IF (MABAL(I).EQ.'ALPY')THEN ALPY(III)=VALUE(I) END IF IF (MABAL(I).EQ.'ALPZ')THEN ALPZ(III)=VALUE(I) END IF IF (MABAL(I).EQ.'GXY')THEN AMODRIG(III)=VALUE(I) END IF 7114 CONTINUE GOTO 10 END IF C C C *NDTEMPER C IF(LINE(1:9).EQ.'*NDTEMPER'.OR.LINE(1:9).EQ.'*ndtemper') THEN PRINT*,'NODAL TEMPERATURES' DO 136 JJ=1,INTEMP READ(13,*) ITNODE(JJ),LABC,TNVAL(JJ) 136 CONTINUE END IF C C C *SPDISP C C LDISP=0 133 IF (LINE(1:7).EQ.'*SPDISP'.OR.LINE(1:7).EQ.'*spdisp')THEN LDISP=1 PRINT*,'SPDISP' CALL BC(NODED,LABEL,DISP,DIS) DO 801 i=1,dis C print *, noded(i),label(i),disp(i) IF(LABEL(I).EQ.'UX') THEN IF(DISP(I).EQ.0.) THEN IFIXTYPE(I)=1 ELSE IFIXTYPE(I)=3 END IF END IF IF(LABEL(I).EQ.'UY') THEN IF(DISP(I).EQ.0.) THEN IFIXTYPE(I)=2 ELSE IFIXTYPE(I)=4 END IF END IF C PRINT *, NODED(I),IFIXTYPE(I),DISP(I) 801 continue GOTO 10 END IF C C *CFORCE C IF (LINE(1:7).EQ.'*CFORCE'.OR.LINE(1:7).EQ.'*cforce')THEN PRINT*,'CFORCE' NCLOAD=1 DO 40 I=1,FOR READ(13,65) LINE C FIND POSITION OF EACH COMMA K=1 DO 235 J=1,80 IF( LINE(J:J).EQ.',') THEN POS(K)=J K=K+1 END IF 235 CONTINUE C SHUFFLE THINGS UP AND PUT IN FIRST ' K=POS(1)+1 DO 237 JJ=79,K,-1 LL=JJ-1 LINE(JJ:JJ)=LINE(LL:LL) 237 CONTINUE LINE(K:K)="'" C NOW FOR SECOND ' K=POS(2)+1 DO 238 JJ=79,K,-1 LL=JJ-1 LINE(JJ:JJ)=LINE(LL:LL) 238 CONTINUE LINE(k:k)="'" C WRITE TO AND THEN READ FROM SCRATCH FILE WRITE(12,*) (LINE(J:J),J=1,80) BACKSPACE (UNIT=12) BACKSPACE (UNIT=12) READ(12,*,END=7227) NODEA(I),LABAL(I),FORC(I) 236 CONTINUE 40 CONTINUE 7227 CONTINUE DO 114 I=1,FOR DO 181 J=1,3 FORCE(I,J)=0 181 CONTINUE IF (LABAL(I).EQ.'FX')THEN FORCE(I,1)=FORC(I) END IF IF (LABAL(I).EQ.'FY')THEN FORCE(I,2)=FORC(I) END IF IF (LABAL(I).EQ.'FZ')THEN FORCE(I,3)=FORC(I) END IF 114 CONTINUE GOTO 10 END IF C C *PRESSURE C IF (LINE(1:9).EQ.'*PRESSURE'.OR.LINE(1:9).EQ.'*pressure')THEN PRINT*,'PRESSURE' DO 50 I=1,LPRES IHIS(I)=0 READ(13,*)NELID(I),JUNKA,JUNKB,IDFACE(I),JUNKC, +JUNKD,UPRES(I),IHIS(I) JUNKA=0 50 CONTINUE GOTO 10 END IF C C C *BODYFORCE C IF (LINE(1:7).EQ.'*BODYFO'.OR.LINE(1:7).EQ.'*bodyfo')THEN PRINT*,'BODYFORCE' READ(13,*) OMEGAX,OMEGAY,OMEGAZ,ACCELX,ACCELY,ACCELZ IF (BOD.EQ.2) THEN READ(13,*) ALPHAX,ALPHAY,ALPHAZ,XO,YO,ZO ENDIF GOTO 10 END IF C C *ENDCASE C IF (LINE(1:8).EQ.'*ENDDATA'.OR.LINE(1:8).EQ.'*enddata') THEN PRINT*,'ENDDATA' CLOSE (UNIT=12) CLOSE (UNIT=13) GOTO 5005 END IF C C *LDCASE C IF (LINE(1:7).EQ.'*LDCASE'.OR.LINE(1:7).EQ.'*ldcase') THEN PRINT*,'LDCASE' READ(13,*) KELFR,KRCTN,KSTR,KSTN,LQ1,LQ2,LQ7,TSFRE C READ(13,65) LINE END IF GOTO 10 5005 CONTINUE C C C C C C C************************************************************* C C PREPARING FRANC2D FILE C C PRINT*,'PROCESSING FRANC2D INPUT FILE' C C****************************************************** C C NUMBER OF NODES,NUMBER OF ELEMENTS,NUMBER OF MATERIALS C PROBLEM TYPE ( ITYP _ 0=axisymetrical, 1=plane) C WRITE(11,1010) NODES,ELEMENT,MANN,ITYP C C C C MATERIAL DATA C PRINT*,'MATERIAL DATA' FRACTUF=1. THICK=1. DO 750 I=1,MANN IF(EY(I).EQ.0..OR.ITYP.EQ.0) THEN C ISOTROPIC MATYPE=1 WRITE(11,751) MATYPE,EX(I),ANUXY(I),THICK,FRACTUF,DENS(I) ELSE C ORTHOTROPIC MATYPE=2 ROTBETA(I)=0. WRITE(11,751) MATYPE,EX(I),EY(I),EZ(I),AMODRIG(I),ANUXY(I), +ANUXZ(I),ANUYZ(I),ROTBETA(I),THICK,FRACTUF,FRACTUF, +DENS(I) END IF 750 CONTINUE 751 FORMAT(I5,14E10.2) C PRINT*,'ELEMENT DATA' KR=1 KS=1 C C TWO-DIMENSIONAL ISOPARAMETRIC ELEMENT DATA C PLANE STRESS, PLANE STRAIN, AXISYMETRIC C PRINT*,'2D ELEMENT DATA ' DO 51 I=1,ELEMENT II=NSRL2(I) IF (NKTP(II).LE.3)THEN IEL=4 IF(NORDR(II).EQ.10)THEN NODE(I,7)=0. NODE(I,8)=0. END IF WRITE(11,1010)NELID2(I),MATID(I),(NODE(I,J),J=1,8) 1010 FORMAT(10I5) END IF 51 CONTINUE C C C C NODE CO-ORDINATE DATA C C PRINT*,'NODE SECTION' DO 102 I=1,NODES KN=0 JJ=NODER(I) WRITE(11,400) JJ,X(I),Y(I) 400 FORMAT(I5,8x,E13.6,8x,E13.6) 102 CONTINUE 410 FORMAT(I6,I3,6E10.4,6F6.0) C C C TEMPERATURE DEPENDANT MATERIAL PROPS C IPAIR=5 print*,'No. of materials (MANN)=',MANN DO 158 I=1,MANN III=MATNUM(I) print*,'MATNUM(I)=',MATNUM(I),' III=',III print*,'I=',I 155 FORMAT(A7) C ROUTINE FOR 'EX' IF(MTYPE(III,1).EQ.1)THEN WRITE(11,155)'TEMPPRP' WRITE(11,156) I,IPAIR,1 156 FORMAT(3I5) DO 159 J=1,5 WRITE(11,157) TEMPTAB(III,1,J),COEFF(III,1,J) 157 FORMAT(2E10.4) 159 CONTINUE END IF C ROUTINE FOR'NUXY' IF(MTYPE(III,2).EQ.1)THEN WRITE(11,155)'TEMPPRP' WRITE(11,156) I,IPAIR,2 DO 161 J=1,5 WRITE(11,157) TEMPTAB(III,2,J),COEFF(III,2,J) 161 CONTINUE END IF C ROUTINE FOR'ALPX' IF(MTYPE(III,4).EQ.1)THEN WRITE(11,155)'TEMPPRP' WRITE(11,156) I,IPAIR,4 DO 160 J=1,5 WRITE(11,157) TEMPTAB(III,4,J),COEFF(III,4,J) 160 CONTINUE END IF 158 CONTINUE C C C APPLIED PRESSURE LOAD DATA C SKIP FOR PLATE ELEMENTS C IF(LPRES.GT.0)THEN PRINT*,'APPLIED PRESSURE' PRINT*,'LTYPE = ',LTYPE PRINT*,'PRESSURE' WRITE(11,142) 'APRESS' 142 FORMAT(A6) WRITE(11,420) LPRES LDCASE=1 DO 129 I=1,LPRES WRITE(11,420) NELID(I),IDFACE(I),LDCASE,UPRES(I) 420 FORMAT(3I5,E10.4) 129 CONTINUE END IF 149 CONTINUE C C NODAL TEMPERATURE DATA C C IF(INTEMP.NE.0) THEN PRINT*, 'NODAL TEMPERATURES' LDCASE=1 CTE=1.E-06 WRITE(11,141) 'ANODTMP' WRITE(11,139) INTEMP,LDCASE,CTE DO 138 JJ=1,INTEMP WRITE(11,140) ITNODE(JJ),TNVAL(JJ) 138 CONTINUE 139 FORMAT(2I5,E10.4) 140 FORMAT(I5,E10.4) 141 FORMAT(A7) ENDIF C C C STRESS FREE TEMPERATURE C IF(TSFRE.NE.0.) THEN PRINT*, 'STRESS FREE TEMP' WRITE(11,141) 'AREFTMP' WRITE(11,140) LDCASE,TSFRE END IF C C C NODAL DISPLACEMENTS C IF(LDISP.NE.0) THEN PRINT*,'NODAL DISPLACEMENTS' WRITE(11,141) 'AFIXITY' WRITE(11,139) DIS DO 143 I=1,DIS WRITE(11,139) NODED(I),IFIXTYPE(I),DISP(I) 143 CONTINUE ENDIF C C C NODAL FORCES C C IF(NCLOAD.NE.0) THEN PRINT*, 'NODAL FORCES' WRITE(11,141) 'ALOADS' DO 144 I=1,FOR WRITE(11,145) NODEA(I),LDCASE,FORCE(I,1),FORCE(I,2) 145 FORMAT(2I5,2E10.4) 144 CONTINUE END IF C C C BODY FORCES C C IF(BOD.NE.0) THEN PRINT*, 'BODY FORCES' WRITE(11,142) 'AACCEL' IF(LYTP.EQ.1) THEN WRITE(11,146) LDCASE,ACCELX,ACCELY ELSE WRITE(11,146) LDCASE,OMEGAX,OMEGAY 146 FORMAT(I5,2E10.4) END IF END IF C C C C 500 PRINT*,'WRITING OF FRANC2D FILE COMPLETED' 171 CONTINUE CLOSE (UNIT=10) CLOSE (UNIT=11) CLOSE (UNIT=12) CLOSE (UNIT=13) END C************************************************** SUBROUTINE CNT(COUNT, LINE1) CHARACTER*80 LINE INTEGER COUNT COMMON /GETIT/ LINE COUNT=0 10 READ(13,65) LINE 65 FORMAT(A80) 66 FORMAT(A1) IF (LINE(1:1).NE.'*')THEN COUNT=COUNT+1 GOTO 10 END IF C IF (LINE(2:2).EQ.'*') THEN C GOTO 10 C END IF END C************************************************** C C SUBROUTINE BC(N,L,X,NR) DIMENSION N(2000),X(2000),POS(200) CHARACTER*4 L(2000) CHARACTER*80 LINE c READ(10,65) LINE 65 FORMAT(A80) DO 30 I=1,NR READ (13,65) LINE C FIND POSITION OF EACH COMMA K=1 DO 225 J=1,80 IF( LINE(J:J).EQ.',') THEN POS(K)=J K=K+1 END IF 225 CONTINUE C SHUFFLE THINGS UP TO PUT IN FIRST ' K=POS(1)+1 DO 227 JJ=79,K,-1 LL=JJ-1 LINE(JJ:JJ)=LINE(LL:LL) 227 CONTINUE LINE(K:K)="'" C NOW FOR THE SECOND ' K=POS(2)+1 DO 228 JJ=79,K,-1 LL=JJ-1 LINE(JJ:JJ)=LINE(LL:LL) 228 CONTINUE C WRITE OUT TO SCRATCH FILE AND READ BACK LINE(K:K)="'" c careful! NISA has two and four letter names K=POS(1)+4 IF(LINE(K:K).EQ.' ') THEN DO 229 JJ=K,78 LL=JJ+2 LINE(JJ:JJ)=LINE(LL:LL) 229 CONTINUE END IF 2291 CONTINUE WRITE(12,*) (LINE(J:J),J=1,80) BACKSPACE (UNIT=12) BACKSPACE (UNIT=12) READ(12,*,END=226) N(I),L(I),X(I) C PRINT *, N(I),L(I),X(I) 226 CONTINUE 30 CONTINUE END C C ****************************************** C SUBROUTINE BCD(N,L,NI,NR) DIMENSION N(2000),NI(2000),POS(200) CHARACTER*4 L(2000) CHARACTER*80 LINE 65 FORMAT(A80) DO 30 I=1,NR READ (13,65) LINE C FIND POSITION OF EACH COMMA K=1 DO 225 J=1,80 IF( LINE(J:J).EQ.',') THEN POS(K)=J K=K+1 END IF 225 CONTINUE C SHUFFLE THINGS UP TO PUT IN FIRST ' K=POS(1)+1 DO 227 JJ=79,K,-1 LL=JJ-1 LINE(JJ:JJ)=LINE(LL:LL) 227 CONTINUE LINE(K:K)="'" C NOW FOR THE SECOND ' K=POS(2)+1 DO 228 JJ=79,K,-1 LL=JJ-1 LINE(JJ:JJ)=LINE(LL:LL) 228 CONTINUE C WRITE OUT TO SCRATCH FILE AND READ BACK LINE(K:K)="'" c careful! NISA has two and four letter names K=POS(1)+4 IF(LINE(K:K).EQ.' ') THEN DO 229 JJ=K,78 LL=JJ+2 LINE(JJ:JJ)=LINE(LL:LL) 229 CONTINUE END IF 2291 CONTINUE WRITE(12,*) (LINE(J:J),J=1,80) BACKSPACE (UNIT=12) BACKSPACE (UNIT=12) READ(12,*,END=226) N(I),L(I),NI(I) 226 CONTINUE 30 CONTINUE END C C **************************************************** C C SUBROUTINE TO STRIP OUT COMMENT CARDS FRON NISA DECK SUBROUTINE STRIP() CHARACTER*80 LINE 10 READ(10,65,END=5000) LINE 65 FORMAT(A80) IF(LINE(1:1).EQ.'*'.AND.LINE(2:2).EQ.'*') THEN GOTO 10 ELSE WRITE(13,65) LINE IF (LINE(1:8).EQ.'ENDDATA'.OR.LINE(1:8).EQ.'*enddata') THEN RETURN END IF END IF GOTO 10 5000 END C ********************************************