1 : C PRAJUS SOURCE CHAT 07/10/29 21:25:38 5940 2 : C INTERFACE AVEC TRANSF POUR PERMETTRE A CE DERNIER D'ETRE 3 : C ECRIT EN FORTRAN,CE QUI EST PLUS ECONOMIQUE 4 : C 5 : SUBROUTINE PRAJUS(FER,XPROJ,MELEME,NUMELG,NUMNP,ichp) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : -INC CCOPTIO 9 : -INC SMELEME 10 : -INC CCGEOME 11 : SEGMENT/FER/(NFI(ITT),MAI(IPP),ITOUR),AFER.FER 12 : SEGMENT/XPROJ/(X(3,1)) 13 : SEGMENT /SXAUX/(XAUX(2,NFI(/1)),INAT(MAI(/1))) 14 : CHARACTER*(4) MOT 15 : NFMAX=NFI(/1) 16 : MAIMAX=MAI(/1)-1 17 : IMOYE=0 18 : QUAL=0.4 19 : IREGU=4 20 : 930 CONTINUE 20 : CALL LIRCHA(MOT,0,IRETOU) 21 : IF (IRETOU.EQ.0) GOTO 932 22 : IF (MOT.NE.'REGU') GOTO 910 22 : CALL LIRENT(IREGU,1,IRETOU) 23 : IF (IERR.NE.0) RETURN 24 : GOTO 930 25 : 910 CONTINUE 26 : IF (MOT.NE.'MOYE') GOTO 931 26 : CALL LIRREE(XXX,1,IRETOU) 27 : XMOY=XXX 28 : IF (IERR.NE.0) RETURN 29 : IMOYE=1 30 : GOTO 930 31 : 931 CONTINUE 32 : IF (MOT.NE.'QUAL') GOTO 933 32 : CALL LIRREE(XXX,1,IRETOU) 33 : QUAL=XXX 34 : IF (IERR.NE.0) RETURN 35 : GOTO 930 35 : 933 CALL REFUS 36 : 932 CONTINUE 37 : SEGINI SXAUX 38 : NBNN=3 39 : IF (KSURF(ILCOUR).EQ.8.OR.KSURF(ILCOUR).EQ.10) NBNN=4 40 : NBELEM=X(/2)*2 41 : C CORRECTION POUR LE CAS DE FABRICATION DE TRI6 42 : IF (MAI(1).NE.0) NBELEM=NBELEM/4+1 43 : NCTIN=MAI(1)+1 44 : NBSOUS=0 45 : NBREF=0 46 : SEGINI MELEME 47 : MAXPTS=X(/2) 48 : IRECHA=0 48 : CALL TRANSF(NFI(1),NFMAX,MAI(1),MAIMAX,ITOUR,X(1,1),MAXPTS, 49 : # NUM(1,1),NBNN,NBELEM,NUMELG,NUMNP,XAUX(1,1),NUMINI,ICLE, 50 : # QUAL,INAT(1),IREGU,IMOYE,XMOY,NBNN,IRECHA,ichp) 51 : IF(IRECHA.NE.0) THEN 51 : CALL ERREUR(IRECHA) 52 : IF (IRECHA.EQ.27.AND.IOLEC.NE.5) IERR=2 53 : RETURN 54 : ENDIF 55 : SEGSUP FER,SXAUX 56 : IF (ICLE.EQ.0) RETURN 56 : CALL PRAMEL(XPROJ,MELEME,NUMELG,NUMNP,NUMINI,ICLE,QUAL,NCTIN,NBNN) 57 : RETURN 58 : END 59 : 60 : 61 : 62 : 63 : 64 : 65 : 66 :
© Cast3M 2003 - All rights reserved.
Disclaimer