Esope source files

   1 : C KAL2P     SOURCE    CHAT      05/01/13    00:50:37     5004           
   2 :       SUBROUTINE KAL2P(MTABP,MCHB)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : 
   6 : -INC SMTABLE
   7 :       POINTEUR MTABP.MTABLE,MTABX.MTABLE
   8 : *-INC SMMATRAKANC
   9 : C*************************************************************************
  10 : C                                                                               
  11 : C    REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES  puis assemblees
  12 : C                                                                               
  13 : 
  14 : * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  15 : * (points CENTRE ) pour chaque operateur de contrainte
  16 : * KGEOC SPG pour la totalite des points CENTRE.
  17 : * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  18 : * KLEMC Connectivites de l'ensemble des contraintes
  19 : * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  20 : 
  21 :       SEGMENT MATRAK
  22 :       INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  23 :       INTEGER LIZAFM(NBSOUS)
  24 :       INTEGER IKAM0 (NBSOUS)
  25 :       INTEGER IMEM  (NBELC)
  26 :       INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  27 :       ENDSEGMENT
  28 : 
  29 :       SEGMENT IZAFM                                                             
  30 :       REAL*8  AM(NNELP,NP,IESP),RPGI(NELAX)
  31 :       ENDSEGMENT                                                                
  32 : 
  33 :       POINTEUR IPMJ.IZAFM,IPMK.IZAFM
  34 : 
  35 : C*******************************************************************            
  36 : -INC SMELEME
  37 : -INC SMLMOTS
  38 : -INC SMCHPOI
  39 :       POINTEUR MPOV1.MPOVAL,IZCH2.MCHPOI,IZCCH2.MPOVAL
  40 :       POINTEUR MZQP.MPOVAL
  41 : -INC CCREEL
  42 :       CHARACTER*8 TYPE,NOMO,NOM
  43 :       DIMENSION IXV(3)
  44 : C
  45 : 
  46 : 
  46 :       CALL LICHT(MCHB,MPOVAL,TYPE,IGEOM)
  47 : 
  48 :       TYPE=' '
  48 :       CALL ACMO(MTABP,'LISTOPER',TYPE,MLMOTS)
  49 : 
  50 :       IF(TYPE.NE.'LISTMOTS')THEN
  51 :       RETURN
  52 :       ENDIF
  53 : 
  54 :       TYPE=' '
  54 :       CALL ACMO(MTABP,'DELTAT',TYPE,IDT)
  55 :       IF(TYPE.NE.'FLOTTANT')THEN
  56 :       DT=XGRAND
  57 :       ELSE
  57 :       CALL ACMF(MTABP,'DELTAT',DT)
  58 :       ENDIF
  59 : 
  60 :       TYPE=' '
  60 :       CALL ACMO(MTABP,'MATC',TYPE,MATRAK)
  61 :       IF(TYPE.NE.'MATRAK')THEN
  62 :       WRITE(6,*)' Pb dans KAL2P : table EQPR erronee '
  63 :       RETURN
  64 :       ENDIF
  65 :       SEGACT MATRAK
  66 : 
  67 :       SEGACT MLMOTS
  68 :       NBOP=MOTS(/2)
  69 : 
  70 :       DO 1 L=1,NBOP
  71 : 
  72 :       NOMO=MOTS(L)
  73 :       IF(L.LT.10)THEN
  74 :       NOM=NOMO(2:5)
  75 :       ELSE
  76 :       NOM=NOMO(3:6)
  77 :       ENDIF
  78 : 
  79 : C     write(6,*)' Second membre NOMO ? ',NOMO
  80 :       TYPE=' '
  80 :       CALL ACMO(MTABP,NOMO,TYPE,MTABX)
  81 :       IF(TYPE.NE.'TABLE')THEN
  82 :       WRITE(6,*)' Pb dans KAL2P : table EQPR erronee '
  83 :       RETURN
  84 :       ENDIF
  85 : 
  85 :       CALL ACME(MTABX,'IARG',IARG)
  86 :       IF(IARG.EQ.0)THEN
  87 : C     write(6,*)' pas d''argument pour ',NOMO
  88 :       GO TO 1
  89 :       ENDIF
  90 : 
  91 :       TYPE=' '
  91 :       CALL ACMO(MTABX,'IZCH2',TYPE,IZCH2)
  92 :       IF(TYPE.NE.'CHPOINT ')THEN
  93 :       IZCH2=0
  94 :       ELSE
  94 :       CALL LICHT(IZCH2,IZCCH2,TYPE,IGEOM)
  95 : 
  96 : C"    nbz=IZCCH2.VPOCHA(/1)
  97 : C"    write(6,*)' IZCCH2=',IZCCH2,' NBZ=',nbz
  98 : C"    write(6,1002)(IZCCH2.VPOCHA(II,1),ii=1,nbz)
  99 :       ENDIF
 100 : 
 101 :       N1=IDEBS(L)
 102 :       N2=IFINS(L)
 103 : 
 104 : C"    TYPE=' '
 104 : C"    CALL ACMO(MTABX,'ARG1',TYPE,ICHP)
 105 : C"    IF(TYPE.EQ.'FLOTTANT')THEN
 105 : C"    CALL ACMF(MTABX,'ARG1',XVAL)
 106 : 
 107 : 
 107 :       CALL LEKTAB(MTABP,'INCO',KINC)
 108 : 
 108 :       CALL LEKTAB(MTABX,'DOMZ',MTABZ)
 109 :       TYPE=' '
 109 :       CALL ACMO(MTABZ,'CENTRE',TYPE,MELEMC)
 110 :       TYPE=' '
 110 :       CALL ACMO(MTABZ,'SOMMET',TYPE,MELEMS)
 111 : 
 112 :       IF(NOM.EQ.'PRES    ')THEN
 113 :       IXV(1)=MELEMC
 114 :       IXV(2)=1
 115 :       IXV(3)=0
 115 :       CALL LEKCOF('Opérateur PRESSION :',
 116 :      & MTABX,KINC,1,IXV,MQP,MZQP,NPT1,NC1,IKQ,IRET)
 117 :       IF(IRET.EQ.0)RETURN
 118 :       ELSE
 119 :       IXV(1)=MELEMS
 120 :       IXV(2)=1
 121 :       IXV(3)=0
 121 :       CALL LEKCOF('Opérateur '//NOM//' :',
 122 :      & MTABX,KINC,1,IXV,MQP,MZQP,NPT1,NC1,IKQ,IRET)
 123 :       ENDIF
 124 : 
 125 : C"    IF(IKQ.EQ.1)THEN
 126 : C"
 127 : C"    XVAL= MZQP.VPOCHA(1,1)
 128 : C"
 129 : C"    IF(IZCH2.EQ.0)THEN
 130 : C"    DO 21 I=N1,N2
 131 : C"    VPOCHA(I,1)=VPOCHA(I,1)+XVAL
 132 : C21   CONTINUE
 133 : C"    ELSE
 134 : C"    II=0
 135 : C"    DO 22 I=N1,N2
 136 : C"    II=II+1
 137 : C"    VPOCHA(I,1)=VPOCHA(I,1)+XVAL*IZCCH2.VPOCHA(II,1)/DT
 138 : C22   CONTINUE
 139 : C"    SEGDES IZCCH2
 140 : C"    ENDIF
 141 : C"    ELSEIF(IKQ.EQ.0)THEN
 141 : C"     CALL LICHT(ICHP,MPOV1,TYPE,IGEOM)
 142 : C     write(6,*)' DT=',DT,MZQP.VPOCHA(1,1),' izch2',IZCH2
 143 :       IF(IZCH2.EQ.0)THEN
 144 :       II=0
 145 :       DO 31 I=N1,N2
 146 :       II=II+1
 147 :       NKQ=1+(1-IKQ)*(II-1)
 148 : C     VPOCHA(I,1)=VPOCHA(I,1)+MZQP.VPOCHA(NKQ,1)/(DT*.0.9)
 149 :       VPOCHA(I,1)=VPOCHA(I,1)+MZQP.VPOCHA(NKQ,1)/DT
 150 :  31   CONTINUE
 151 :       ELSE
 152 :       II=0
 153 :       DO 32 I=N1,N2
 154 :       II=II+1
 155 :       NKQ=1+(1-IKQ)*(II-1)
 156 :       VPOCHA(I,1)=VPOCHA(I,1)+
 157 : C    &MZQP.VPOCHA(NKQ,1)*IZCCH2.VPOCHA(II,1)
 158 :      &MZQP.VPOCHA(NKQ,1)*IZCCH2.VPOCHA(II,1)/DT
 159 :  32   CONTINUE
 160 :       SEGDES IZCCH2
 161 :       ENDIF
 162 :       SEGDES MZQP
 163 : 
 164 : C"    ELSE
 165 : C"    write(6,*)' On ne fera pas'
 166 : C"    ENDIF
 167 : 
 168 :  1    CONTINUE
 169 :       SEGDES MLMOTS,MATRAK,MPOVAL
 170 : 
 171 :       RETURN
 172 :  1001 FORMAT(20(1X,I5))
 173 :  1002 FORMAT(10(1X,1PE11.4))
 174 :       END
 175 :  
 176 :  
 177 :  
 178 :  
 179 :