Télécharger calcga.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales