1 : C KREM1G SOURCE CHAT 05/01/13 01:06:09 5004 2 : SUBROUTINE KREM1G(K2,NF1,NF2,NF3,NA1,NA2,NA3 3 : * ,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : C---------------------------------------------------------------------- 7 : C Calcul des facteurs de forme en 3D 8 : C Sp appele par KPROJG 9 : C UNE SEULE FACE NF1 = NF2 = NF3 10 : C LE NOMBRE DE CELLULES DE PROJECTION DE L'ARETE NA EST NCEL(1,NA) 11 : C CF. KREMPA 12 : C 13 : C---------------------------------------------------------------------- 14 : C 15 : DIMENSION U2(4),KG(2),KH(2) 16 : -INC TFFOR3D 17 : SEGMENT SKSEGM 18 : INTEGER KKSEGM(2,NSEGM) 19 : ENDSEGMENT 20 : C 21 : C DESCRIPTION DES ARETES 22 : C 23 : SEGMENT SKCEL 24 : INTEGER KBCEL(NR,NR),IINT(2,NSTAC),IS(NSTAC),JS(NSTAC) 25 : REAL*8 RMAX 26 : ENDSEGMENT 27 : C 28 : C-------------------------------------------------------------------- 29 : C 30 : NR = IR(/1) 31 : C UNE SEULE FACE 32 : C -------------- 33 : C 33 : CALL KINITB(KBCEL,NR,NR,KG,NG) 33 : CALL KREMPA(K2,KG,NG,NF1,NA1,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 33 : CALL KREMPA(K2,KG,NG,NF2,NA2,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 33 : CALL KREMPA(K2,KG,NG,NF3,NA3,1,C,U2,SHC3D,SKCEL,SPROJA,SKBUFF) 34 : KH(1) = ( KG(1) + 1)/NG 35 : KH(2) = ( KG(2) + 1)/NG 36 : 37 : C 38 : C WRITE(6,*) ' KREM1G NCEL ',NCEL(1,NA1),NCEL(1,NA2),NCEL(1,NA3) 39 : 40 : IF(NCEL(1,NA1).LE.2.OR.NCEL(1,NA2).LE.2.OR.NCEL(1,NA3).LE.2) THEN 41 : 42 : IF (KIMP.GE.4) THEN 43 : WRITE(6,*) ' NF KG ',NF1,KH(1),KH(2), ' TRIANGLE APLATI ** ' 44 : DO 2 I =1,NRES 45 : WRITE(6,*) (KBCEL(I,J),J=1,NRES) 46 : 2 CONTINUE 47 : ENDIF 48 : 49 : ELSEIF (KBCEL(KH(1),KH(2)).EQ.1) THEN 50 : 51 : IF (KIMP.GE.4) THEN 52 : WRITE(6,*) ' NF KG ',NF1,KH(1),KH(2), ' CONTOUR ** ' 53 : DO 3 I =1,NRES 54 : WRITE(6,*) (KBCEL(I,J),J=1,NRES) 55 : 3 CONTINUE 56 : ENDIF 57 : ELSE 58 : 58 : CALL KREMPI(NIN,K2,KG,NG,NF1,C,U2,SHC3D,SKCEL,SKBUFF) 59 : 60 : ENDIF 61 : C| 62 : C 63 : RETURN 64 : END 65 : 66 :
© Cast3M 2003 - All rights reserved.
Disclaimer