Download calcga.eso

Back to the list

   1 : C CALCGA    SOURCE    GOUNAND   07/07/05    21:15:00     5784           
   2 :       SUBROUTINE CALCGA(IVCOM,IICOM,JMAJAC,JMIJAC,JDTJAC,JMAREG,JDIAMA,
   3 :      $     JPC,
   4 :      $     METRIQ,
   5 :      $     TATRAV,
   6 :      $     FC,
   7 :      $     IMPR,IRET)
   8 :       IMPLICIT REAL*8 (A-H,O-Z)
   9 :       IMPLICIT INTEGER (I-N)
  10 : C***********************************************************************
  11 : C NOM         : CALCGA
  12 : C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss
  13 : C     
  14 : C     
  15 : C LANGAGE     : ESOPE
  16 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17 : C               mél : gounand@semt2.smts.cea.fr
  18 : C***********************************************************************
  19 : C APPELES          :
  20 : C APPELE PAR       :
  21 : C***********************************************************************
  22 : C ENTREES            :
  23 : C ENTREES/SORTIES    :
  24 : C SORTIES            : -
  25 : C TRAVAIL            :
  26 : C***********************************************************************
  27 : C VERSION    : v3.1, 30/07/04, possiblité de travailler
  28 : C                  dans l'espace de référence et d'avoir les comp. de la
  29 : C                  matrice jacobienne.
  30 : C VERSION    : v1, 11/05/04, version initiale
  31 : C HISTORIQUE : v1, 11/05/04, création
  32 : C HISTORIQUE :
  33 : C HISTORIQUE :
  34 : C***********************************************************************
  35 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36 : C en cas de modification de ce sous-programme afin de faciliter
  37 : C la maintenance !
  38 : C***********************************************************************
  39 : -INC CCOPTIO
  40 : CBEGININCLUDE SMCHAEL
  41 :       SEGMENT MCHAEL
  42 :       POINTEUR IMACHE(N1).MELEME
  43 :       POINTEUR ICHEVA(N1).MCHEVA
  44 :       ENDSEGMENT
  45 :       SEGMENT MCHEVA
  46 :       REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  47 :       ENDSEGMENT
  48 :       SEGMENT LCHEVA
  49 :       POINTEUR LISCHE(NBCHE).MCHEVA
  50 :       ENDSEGMENT
  51 : CENDINCLUDE SMCHAEL
  52 :       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  53 :       POINTEUR FC.MCHEVA
  54 :       POINTEUR LCOF.LCHEVA
  55 :       POINTEUR MYCOF.MCHEVA
  56 :       POINTEUR JMAJAC.MCHEVA
  57 :       POINTEUR JMIJAC.MCHEVA
  58 :       POINTEUR JDTJAC.MCHEVA
  59 :       POINTEUR JMAREG.MCHEVA
  60 :       POINTEUR JDIAMA.MCHEVA
  61 :       POINTEUR JPC.MCHEVA
  62 : * les MCHEVA des coefficient
  63 : CBEGININCLUDE SLCOMP
  64 :       SEGMENT COMP
  65 :       CHARACTER*8 NOMCOM
  66 :       INTEGER DERCOF(NCOCOF)
  67 :       LOGICAL LTREF
  68 :       ENDSEGMENT
  69 :       SEGMENT COMPS
  70 :       POINTEUR LISCOM(NBCOMP).COMP
  71 :       ENDSEGMENT
  72 : CENDINCLUDE SLCOMP
  73 :       POINTEUR IVCOM.COMP
  74 : CBEGININCLUDE SMPOUET
  75 :       SEGMENT TABGEO
  76 :       CHARACTER*4 DISGEO
  77 :       POINTEUR IGEO.MCHAEL
  78 :       ENDSEGMENT
  79 :       SEGMENT TABVDC
  80 :       INTEGER VVARPR(NUMVPR)
  81 :       INTEGER VVARDU(NUMVDU)
  82 :       INTEGER VDATPR(NUMDPR)
  83 :       INTEGER VDATDU(NUMDDU)
  84 :       INTEGER VCOFPR(NUMCPR)
  85 :       INTEGER VCOFDU(NUMCDU)
  86 :       INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  87 :       INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  88 :       POINTEUR VLCOF(JLCOF).MLENTI
  89 :       POINTEUR VCOMP(JGCOF).COMP
  90 :       POINTEUR VLDAT(JGCOF).MLENTI
  91 :       INTEGER  DJSVD(JGVD)
  92 :       POINTEUR NOMVD(JGVD).MLMOTS
  93 :       POINTEUR MVD(JGVD).MCHPOI
  94 :       REAL*8 XVD(JGVD)
  95 :       CHARACTER*4 DISVD(KGVD)
  96 :       ENDSEGMENT
  97 :       SEGMENT TATRAV
  98 :       POINTEUR VVCOF(JLCOF).MCHEVA
  99 :       POINTEUR VCOF(JGCOF).MCHEVA
 100 :       POINTEUR IVD(JGVD).MCHAEL
 101 :       POINTEUR VD(JGVD).MCHEVA
 102 :       POINTEUR DVD(JGVD).MCHEVA
 103 :       POINTEUR FFVD(KGVD).MCHEVA
 104 :       POINTEUR DFFVD(KGVD).MCHEVA
 105 :       LOGICAL LVCOF(JGCOF)
 106 :       LOGICAL LVD(JGVD)
 107 :       LOGICAL LDVD(JGVD)
 108 :       LOGICAL LFFVD(KGVD)
 109 :       LOGICAL LDFFVD(KGVD)
 110 :       ENDSEGMENT
 111 :       SEGMENT TABMAT
 112 :       POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
 113 :       ENDSEGMENT
 114 : CENDINCLUDE SMPOUET
 115 : -INC SMLENTI
 116 :       POINTEUR IICOM.MLENTI
 117 : CBEGININCLUDE TMPREC
 118 :       SEGMENT MPREC
 119 :       POINTEUR DAT(NDAT).MCHEVA
 120 :       POINTEUR PREC(NPREC).MCHEVA
 121 :       ENDSEGMENT
 122 : CENDINCLUDE TMPREC
 123 :       POINTEUR METRIQ.MPREC
 124 : * Segments où l'on stocke les nombres d'éléments et nombre de points de
 125 : * Gauss pour chaque champ à fin de vérification
 126 :       POINTEUR LNELEM.MLENTI
 127 :       POINTEUR LNPOGA.MLENTI
 128 : *     
 129 :       REAL*8 XFCOM
 130 : * Si IPRDU=1, on va chercher les coeffs dans VCOFPR
 131 : * Si IPRDU=2, on va chercher les coeffs dans VCOFDU
 132 :       INTEGER IPRDU
 133 :       INTEGER IMPR,IRET
 134 :       CHARACTER*8 NOMLOI
 135 :       LOGICAL LREF
 136 :       LOGICAL LJACO
 137 : *     
 138 : * Executable statements
 139 : *     
 140 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calcga'
 141 : *      IESREL=IDIM
 142 : *     
 143 :       NBCHE=0
 144 :       SEGINI LCOF
 145 :       JG=0 
 146 :       SEGINI LNELEM
 147 :       JG=0 
 148 :       SEGINI LNPOGA
 149 : *     
 150 : *      SEGPRT,TABVC
 151 : *      WRITE(IOIMP,*) 'IPRDU=',IPRDU
 152 :       SEGACT IVCOM
 153 :       SEGACT IICOM
 154 :       NCOCOF=IVCOM.DERCOF(/1)
 155 :       LJACO=IVCOM.LTREF
 156 :       DO ICOCOF=1,NCOCOF
 157 :          IJGVD=IICOM.LECT(ICOCOF)
 158 :          LDER=IVCOM.DERCOF(ICOCOF)
 159 :          IF (LDER.EQ.0) THEN
 160 :             MYCOF=TATRAV.VD(IJGVD)
 161 :             SEGACT MYCOF
 162 :             NEL=MYCOF.VELCHE(/6)
 163 :             NPG=MYCOF.VELCHE(/5)
 164 :             SEGDES MYCOF
 165 :             LCOF.LISCHE(**)=MYCOF
 166 :             LNELEM.LECT(**)=NEL
 167 :             LNPOGA.LECT(**)=NPG
 168 :          ELSEIF (LDER.EQ.1) THEN
 169 :             MYCOF=TATRAV.DVD(IJGVD)
 170 :             SEGACT MYCOF
 171 :             NEL=MYCOF.VELCHE(/6)
 172 :             NPG=MYCOF.VELCHE(/5)
 173 :             SEGDES MYCOF
 174 :             LCOF.LISCHE(**)=MYCOF
 175 :             LNELEM.LECT(**)=NEL
 176 :             LNPOGA.LECT(**)=NPG
 177 :          ELSEIF (LDER.EQ.2) THEN
 178 :             MYCOF=TATRAV.VD(IJGVD)
 179 :             SEGACT MYCOF
 180 :             NEL=MYCOF.VELCHE(/6)
 181 :             NPG=MYCOF.VELCHE(/5)
 182 :             SEGDES MYCOF
 183 :             LCOF.LISCHE(**)=MYCOF
 184 :             LNELEM.LECT(**)=NEL
 185 :             LNPOGA.LECT(**)=NPG
 186 :             MYCOF=TATRAV.DVD(IJGVD)
 187 :             SEGACT MYCOF
 188 :             NEL=MYCOF.VELCHE(/6)
 189 :             NPG=MYCOF.VELCHE(/5)
 190 :             SEGDES MYCOF
 191 :             LCOF.LISCHE(**)=MYCOF
 192 :             LNELEM.LECT(**)=NEL
 193 :             LNPOGA.LECT(**)=NPG
 194 :          ELSE
 195 :             WRITE(IOIMP,*) 'Erreur Grave 2' 
 196 :             GOTO 9999
 197 :          ENDIF
 198 :       ENDDO
 199 :       SEGDES IICOM
 200 : *     
 201 : * Cas particulier des coeffs dépendant de la matrice
 202 : * jacobienne
 203 : *     
 204 :       IF (LJACO) THEN
 205 :          SEGACT JMAJAC
 206 :          NEL=JMAJAC.VELCHE(/6)
 207 :          NPG=JMAJAC.VELCHE(/5)
 208 :          SEGDES JMAJAC
 209 :          LCOF.LISCHE(**)=JMAJAC
 210 :          LNELEM.LECT(**)=NEL
 211 :          LNPOGA.LECT(**)=NPG
 212 :          IF (JMIJAC.NE.0) THEN
 213 :             SEGACT JMIJAC
 214 :             NEL=JMIJAC.VELCHE(/6)
 215 :             NPG=JMIJAC.VELCHE(/5)
 216 :             SEGDES JMIJAC
 217 :          ELSE
 218 :             NEL=0
 219 :             NPG=0
 220 :          ENDIF
 221 :          LCOF.LISCHE(**)=JMIJAC
 222 :          LNELEM.LECT(**)=NEL
 223 :          LNPOGA.LECT(**)=NPG
 224 :          SEGACT JDTJAC
 225 :          NEL=JDTJAC.VELCHE(/6)
 226 :          NPG=JDTJAC.VELCHE(/5)
 227 :          SEGDES JDTJAC
 228 :          LCOF.LISCHE(**)=JDTJAC
 229 :          LNELEM.LECT(**)=NEL
 230 :          LNPOGA.LECT(**)=NPG
 231 :          IF (JMAREG.NE.0) THEN
 232 :             SEGACT JMAREG
 233 :             NEL=JMAREG.VELCHE(/6)
 234 :             NPG=JMAREG.VELCHE(/5)
 235 :             SEGDES JMAREG
 236 :             LCOF.LISCHE(**)=JMAREG
 237 :             LNELEM.LECT(**)=NEL
 238 :             LNPOGA.LECT(**)=NPG
 239 :          ENDIF
 240 :          IF (JDIAMA.NE.0) THEN
 241 :             SEGACT JDIAMA
 242 :             NEL=JDIAMA.VELCHE(/6)
 243 :             NPG=JDIAMA.VELCHE(/5)
 244 :             SEGDES JDIAMA
 245 :             LCOF.LISCHE(**)=JDIAMA
 246 :             LNELEM.LECT(**)=NEL
 247 :             LNPOGA.LECT(**)=NPG
 248 :          ENDIF
 249 :          IF (JPC.NE.0) THEN
 250 :             SEGACT JPC
 251 :             NEL=JPC.VELCHE(/6)
 252 :             NPG=JPC.VELCHE(/5)
 253 :             SEGDES JPC
 254 :             LCOF.LISCHE(**)=JPC
 255 :             LNELEM.LECT(**)=NEL
 256 :             LNPOGA.LECT(**)=NPG
 257 :          ENDIF
 258 :       ENDIF
 259 : * Vérifications des dimensions
 260 : *   Calcul des max
 261 :       JG=LNELEM.LECT(/1)
 262 :       NELMAX=1
 263 :       NPGMAX=1
 264 :       DO IG=1,JG
 265 :          NELMAX=MAX(NELMAX,LNELEM.LECT(IG))
 266 :          NPGMAX=MAX(NPGMAX,LNPOGA.LECT(IG))
 267 :       ENDDO
 268 :       SEGSUP LNELEM
 269 :       SEGSUP LNPOGA
 270 : *   Vérif proprement dite
 271 : * Inutilisable car JMIJAC peut être nul...
 272 : *      SEGACT LCOF.LISCHE(*)
 273 :       NL=LCOF.LISCHE(/1)
 274 :       DO IL=1,NL
 275 :          MYCOF=LCOF.LISCHE(IL)
 276 :          IF (MYCOF.NE.0) THEN 
 277 :             SEGACT MYCOF
 278 :          ENDIF
 279 :       ENDDO
 280 :       IG=0
 281 :       DO ICOCOF=1,NCOCOF
 282 :          LDER=IVCOM.DERCOF(ICOCOF)
 283 :          IF (LDER.EQ.0) THEN
 284 :             IG=IG+1
 285 :             MYCOF=LCOF.LISCHE(IG)
 286 :             NDLIG =MYCOF.VELCHE(/1)
 287 :             NDCOL =MYCOF.VELCHE(/2)
 288 :             N2DLIG=MYCOF.VELCHE(/3)
 289 :             N2DCOL=MYCOF.VELCHE(/4)
 290 :             NDNOEU=MYCOF.VELCHE(/5)
 291 :             NDELM =MYCOF.VELCHE(/6)
 292 :             IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
 293 :      $           N2DCOL.NE.1
 294 :      $           .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
 295 :      $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
 296 :                WRITE(IOIMP,*) 'Erreur dims MYCOF'
 297 :                WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
 298 :                WRITE(IOIMP,*) 'NDLIG=',NDLIG
 299 :                WRITE(IOIMP,*) 'NDCOL=',NDCOL
 300 :                WRITE(IOIMP,*) 'N2DLIG=',N2DLIG
 301 :                WRITE(IOIMP,*) 'N2DCOL=',N2DCOL
 302 :                WRITE(IOIMP,*) 'NDNOEU=',NDNOEU
 303 :                WRITE(IOIMP,*) 'NDELM =',NDELM
 304 :                WRITE(IOIMP,*) 'NPGMAX=',NPGMAX
 305 :                WRITE(IOIMP,*) 'NELMAX=',NELMAX
 306 :                GOTO 9999
 307 :             ENDIF
 308 :          ELSEIF (LDER.EQ.1) THEN
 309 :             IG=IG+1
 310 :             MYCOF=LCOF.LISCHE(IG)
 311 :             NDLIG =MYCOF.VELCHE(/1)
 312 :             NDCOL =MYCOF.VELCHE(/2)
 313 :             N2DLIG=MYCOF.VELCHE(/3)
 314 :             N2DCOL=MYCOF.VELCHE(/4)
 315 :             NDNOEU=MYCOF.VELCHE(/5)
 316 :             NDELM =MYCOF.VELCHE(/6)
 317 :             IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
 318 : * Test faux si utilisation de 'EREF'
 319 : *     $           N2DCOL.NE.IESREL.OR.
 320 :      $           (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
 321 :      $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
 322 :                WRITE(IOIMP,*) 'Erreur dims MYCOF'
 323 :                WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
 324 :                GOTO 9999
 325 :             ENDIF
 326 :          ELSEIF (LDER.EQ.2) THEN
 327 :             IG=IG+1
 328 :             MYCOF=LCOF.LISCHE(IG)
 329 :             NDLIG =MYCOF.VELCHE(/1)
 330 :             NDCOL =MYCOF.VELCHE(/2)
 331 :             N2DLIG=MYCOF.VELCHE(/3)
 332 :             N2DCOL=MYCOF.VELCHE(/4)
 333 :             NDNOEU=MYCOF.VELCHE(/5)
 334 :             NDELM =MYCOF.VELCHE(/6)
 335 :             IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
 336 :      $           N2DCOL.NE.1
 337 :      $           .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
 338 :      $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
 339 :                WRITE(IOIMP,*) 'Erreur dims MYCOF'
 340 :                WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
 341 :                GOTO 9999
 342 :             ENDIF
 343 :             IG=IG+1
 344 :             MYCOF=LCOF.LISCHE(IG)
 345 :             NDLIG =MYCOF.VELCHE(/1)
 346 :             NDCOL =MYCOF.VELCHE(/2)
 347 :             N2DLIG=MYCOF.VELCHE(/3)
 348 :             N2DCOL=MYCOF.VELCHE(/4)
 349 :             NDNOEU=MYCOF.VELCHE(/5)
 350 :             NDELM =MYCOF.VELCHE(/6)
 351 :             IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
 352 : * Test faux si utilisation de 'EREF'
 353 : *     $           N2DCOL.NE.IESREL.OR.
 354 :      $           (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
 355 :      $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
 356 :                WRITE(IOIMP,*) 'Erreur dims MYCOF'
 357 :                WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
 358 :                GOTO 9999
 359 :             ENDIF
 360 :          ENDIF
 361 :       ENDDO
 362 : *     
 363 : * Cas particulier matrice jacobienne
 364 : *     
 365 :       IF (LJACO) THEN 
 366 :          IG=IG+1
 367 :          MYCOF=LCOF.LISCHE(IG)
 368 :          NDLIG =MYCOF.VELCHE(/1)
 369 :          NDCOL =MYCOF.VELCHE(/2)
 370 :          N2DLIG=MYCOF.VELCHE(/3)
 371 : *         N2DCOL=MYCOF.VELCHE(/4)
 372 :          IESREF=MYCOF.VELCHE(/4)
 373 :          NDNOEU=MYCOF.VELCHE(/5)
 374 :          NDELM =MYCOF.VELCHE(/6)
 375 :          IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
 376 :      $        N2DLIG.NE.IDIM.OR.
 377 : *     $        N2DCOL.NE.IDIM.OR.
 378 :      $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
 379 :      $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
 380 :          WRITE(IOIMP,*) 'Erreur dims JMAJAC'
 381 :          GOTO 9999
 382 :       ENDIF
 383 :       IG=IG+1
 384 :       MYCOF=LCOF.LISCHE(IG)
 385 :       IF (MYCOF.NE.0) THEN
 386 :          NDLIG =MYCOF.VELCHE(/1)
 387 :          NDCOL =MYCOF.VELCHE(/2)
 388 :          N2DLIG=MYCOF.VELCHE(/3)
 389 :          N2DCOL=MYCOF.VELCHE(/4)
 390 :          NDNOEU=MYCOF.VELCHE(/5)
 391 :          NDELM =MYCOF.VELCHE(/6)
 392 :          IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
 393 : *     $           N2DLIG.NE.IDIM.OR.N2DCOL.NE.IDIM.OR.
 394 :      $        N2DCOL.NE.IDIM.OR.
 395 :      $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
 396 :      $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
 397 :             WRITE(IOIMP,*) 'Erreur dims JMIJAC'
 398 :             GOTO 9999
 399 :          ENDIF
 400 :       ENDIF
 401 :       IG=IG+1
 402 :       MYCOF=LCOF.LISCHE(IG)
 403 :       NDLIG =MYCOF.VELCHE(/1)
 404 :       NDCOL =MYCOF.VELCHE(/2)
 405 :       N2DLIG=MYCOF.VELCHE(/3)
 406 :       N2DCOL=MYCOF.VELCHE(/4)
 407 :       NDNOEU=MYCOF.VELCHE(/5)
 408 :       NDELM =MYCOF.VELCHE(/6)
 409 :       IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
 410 :      $     N2DLIG.NE.1.OR.N2DCOL.NE.1.OR.
 411 :      $     (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
 412 :      $     .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
 413 :          WRITE(IOIMP,*) 'Erreur dims JDTJAC'
 414 :          GOTO 9999
 415 :       ENDIF
 416 :       IF (JMAREG.NE.0) THEN
 417 :          IG=IG+1
 418 :          MYCOF=LCOF.LISCHE(IG)
 419 :          NDLIG =MYCOF.VELCHE(/1)
 420 :          NDCOL =MYCOF.VELCHE(/2)
 421 :          N2DLIG=MYCOF.VELCHE(/3)
 422 :          N2DCOL=MYCOF.VELCHE(/4)
 423 :          NDNOEU=MYCOF.VELCHE(/5)
 424 :          NDELM =MYCOF.VELCHE(/6)
 425 :          IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
 426 :      $        N2DLIG.NE.IESREF.OR.N2DCOL.NE.IESREF.OR.
 427 :      $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
 428 :      $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
 429 :             WRITE(IOIMP,*) 'Erreur dims JMAREG'
 430 :             GOTO 9999
 431 :          ENDIF
 432 :       ENDIF
 433 :       IF (JDIAMA.NE.0) THEN
 434 :          IG=IG+1
 435 :          MYCOF=LCOF.LISCHE(IG)
 436 :          NDLIG =MYCOF.VELCHE(/1)
 437 :          NDCOL =MYCOF.VELCHE(/2)
 438 :          N2DLIG=MYCOF.VELCHE(/3)
 439 :          N2DCOL=MYCOF.VELCHE(/4)
 440 :          NDNOEU=MYCOF.VELCHE(/5)
 441 :          NDELM =MYCOF.VELCHE(/6)
 442 :          IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
 443 :      $        N2DLIG.NE.1.OR.N2DCOL.NE.1.OR.
 444 :      $        NDNOEU.NE.1.OR.NDELM.NE.1) THEN
 445 :             WRITE(IOIMP,*) 'Erreur dims JDIAMA'
 446 :             GOTO 9999
 447 :          ENDIF
 448 :       ENDIF
 449 :       IF (JPC.NE.0) THEN
 450 :          IG=IG+1
 451 :          MYCOF=LCOF.LISCHE(IG)
 452 :          NDLIG =MYCOF.VELCHE(/1)
 453 :          NDCOL =MYCOF.VELCHE(/2)
 454 :          N2DLIG=MYCOF.VELCHE(/3)
 455 :          N2DCOL=MYCOF.VELCHE(/4)
 456 :          NDNOEU=MYCOF.VELCHE(/5)
 457 :          NDELM =MYCOF.VELCHE(/6)
 458 :          IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
 459 :      $        N2DLIG.NE.1.OR.N2DCOL.NE.1.OR.
 460 :      $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
 461 :      $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
 462 :             WRITE(IOIMP,*) 'Erreur dims JPC'
 463 :             GOTO 9999
 464 :          ENDIF
 465 :       ENDIF
 466 :       ENDIF
 467 : *     
 468 : * Initialisation du segment contenant la valeur de la loi de
 469 : * comportement
 470 :       NBLIG=1
 471 :       NBCOL=1
 472 :       N2LIG=1
 473 :       N2COL=1
 474 :       NBPOI=NPGMAX
 475 :       NBELM=NELMAX
 476 :       SEGINI FC
 477 : *     
 478 : * Calcul proprement dit
 479 : *     
 479 :       CALL CALCGB(IVCOM,LCOF,METRIQ,
 480 :      $     FC,
 481 :      $     IMPR,IRET)
 482 :       IF (IRET.NE.0) GOTO 9999
 483 : *     
 484 : * Fin 
 485 : *     
 486 :       SEGDES FC
 487 : * Inutilisable car JMIJAC peut être nul...
 488 : *      SEGDES LCOF.LISCHE(*)
 489 :       NL=LCOF.LISCHE(/1)
 490 :       DO IL=1,NL
 491 :          MYCOF=LCOF.LISCHE(IL)
 492 :          IF (MYCOF.NE.0) THEN 
 493 :             SEGDES MYCOF
 494 :          ENDIF
 495 :       ENDDO
 496 :       SEGSUP LCOF
 497 :       SEGDES IVCOM
 498 : 
 499 : *     
 500 : * Normal termination
 501 : *     
 502 :       IRET=0
 503 :       RETURN
 504 : *     
 505 : * Format handling
 506 : *     
 507 : *     
 508 : * Error handling
 509 : *     
 510 :  9999 CONTINUE
 511 :       IRET=1
 512 :       WRITE(IOIMP,*) 'An error was detected in subroutine calcga'
 513 :       RETURN
 514 : *     
 515 : * End of subroutine CALCGA
 516 : *     
 517 :       END
 518 : 
 519 :  
 520 :  
 521 :  
 522 :  

© Cast3M 2003 - All rights reserved.
Disclaimer