Télécharger la plaquette Cast3M


fr en

Télécharger hhopil.eso

Retour à la liste

Numérotation des lignes : 

hhopil

  1. C HHOPIL    SOURCE    OF166741  24/12/18    21:15:15     12092          
  2.  
  3. C====== FORMULATION HHO ================================================
  4. C= 
  5. C= (1) Initialisations/Verifications - SAUVER
  6. C=
  7. C=======================================================================
  8.  
  9.       SUBROUTINE HHOPIL(iopt,ient1,ient2)
  10.  
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8 (A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16.  
  17. -INC CCHHOPA
  18. -INC CCHHOPR
  19. -INC CCHHORS
  20.  
  21. -INC SMLENTI
  22. -INC TMCOLAC
  23.  
  24.       DIMENSION ILENA(5)
  25.  
  26. c-dbg      write(ioimp,*) 'HHOPIL E(',iopt,') :',ient1,ient2
  27.  
  28. C= 1 = INITIALISATIONS/VERIFICATIONS = SAUVER ==========================
  29.       IF (iopt .EQ. 1) THEN
  30.         ISAUHO = -99
  31.         IRESHO = -99
  32.         ISSQHO = 0
  33.         ISCEHO = 0
  34.         ISPFHO = 0
  35.         ISPCHO = 0
  36.         NIVEAU = ient1 +1
  37.         IF (NIVEAU .GE. 26) THEN
  38.           ISAUHO = 0
  39.           IF (MSQHHO .GT. 0) ISAUHO = 1
  40.         ELSE
  41.           IF (MSQHHO .GT. 0) THEN
  42.             write(ioimp,*) 'HHOPIL(1) : SAUV HHO non prevu a ce niveau'
  43.             RETURN
  44.           END IF
  45.         END IF
  46.  
  47. C= 2 = VERIFICATIONS ANALYSE IMODELS = SAUVER/REST = DBG ===============
  48.       ELSE IF (iopt .EQ. 2) THEN
  49.         imHHO = ient1
  50.         IF (imHHO.GT.0) THEN
  51.           IF (ISAUHO.NE.1 .AND. ISAUHO.NE.2) THEN
  52.             write(ioimp,*) 'HHOPIL(2) : SAUve HHO non prevu',ISAUHO
  53.             RETURN
  54.           ENDIF
  55.         ENDIF
  56.  
  57. C= 3 = STOCKAGE DES MAILLAGES = SAUVER =================================
  58.       ELSE IF (iopt .EQ. 3) THEN
  59. c-dbg        write(ioimp,*) 'HHOPIL(3) :',isauho
  60.         IF (ISAUHO .NE. 1) RETURN
  61.         ICOLAC = ient1
  62.         IIICHA = ient2
  63.         itlacc = icolac.KCOLA(1)
  64.         ilisse = icolac.ILISSG
  65.         iun    = 1
  66. C*        SEGACT,ilisse*MOD <- Fait en amont de l'appel 
  67.         ISPCHO = 4 + NFAMAX + NCEMAX
  68.         jg = ISPCHO
  69.         SEGINI,mlenti
  70.         jg1 = 0
  71.         mlenti.lect(jg1+1) = MSQHHO
  72.         mlenti.lect(jg1+2) = MCEHHO
  73.         mlenti.lect(jg1+3) = MPFHHO
  74.         mlenti.lect(jg1+4) = MPCHHO
  75.         jg1 = jg1 + 4
  76.         DO i = 1, NFAMAX
  77.           mlenti.lect(jg1+i) = MAFHHO(i)
  78.         END DO
  79.         jg1 = jg1 + NFAMAX
  80.         DO i = 1, NCEMAX
  81.           mlenti.lect(jg1+i) = MACHHO(i)
  82.         END DO
  83.         jg1 = jg1 + NCEMAX
  84. c-dbg        write(ioimp,*) ISPCHO,jg1,mlenti.lect(/1)
  85.         if (jg1.ne.mlenti.lect(/1)) call erreur(5)
  86.         DO i = 1, jg1
  87.           ip = mlenti.lect(i)
  88.           IF (ip.GT.0) then
  89.             CALL AJOUN(itlacc,ip,ilisse,iun)
  90.             IF (IIICHA.EQ.1) ip = -ip
  91.             mlenti.lect(i) = ip
  92.           ELSE
  93.             mlenti.lect(i) = 0
  94.           ENDIF
  95.         END DO
  96.         ISCEHO = mlenti
  97.  
  98.         ISPFHO = 8 + (1+NFAMAX) + (1+NCEMAX) + (2*NFAMAX)
  99.         jg = ISPFHO
  100.         SEGINI,mlenti
  101.         jg1 = 0
  102.         mlenti.lect(jg1+1) = IDIHHO
  103.         mlenti.lect(jg1+2) = IFOHHO
  104.         mlenti.lect(jg1+3) = NUFHHO
  105.         mlenti.lect(jg1+4) = NFAHHO
  106.         mlenti.lect(jg1+5) = NUCHHO
  107.         mlenti.lect(jg1+6) = NCEHHO
  108.         mlenti.lect(jg1+7) = NISFHO
  109.         mlenti.lect(jg1+8) = NISCHO
  110.         jg1 = jg1 + 8
  111.         DO i = 0, NFAMAX
  112.           mlenti.lect(jg1+1+i) = NBFHHO(i)
  113.         END DO
  114.         jg1 = jg1 + 1+NFAMAX
  115.         DO i = 0, NCEMAX
  116.           mlenti.lect(jg1+1+i) = NBCHHO(i)
  117.         END DO
  118.         jg1 = jg1 + 1+NCEMAX
  119.         DO i = 1, NFAMAX
  120.           mlent2 = LOFHHO(i)
  121.           if (mlent2.gt.0) then
  122.             segact,mlent2
  123.             mlenti.lect(jg1+1) = mlent2.lect(1)
  124.             mlenti.lect(jg1+2) = mlent2.lect(2)
  125.             segdes,mlent2
  126.           else
  127.             mlenti.lect(jg1+1) = -999
  128.             mlenti.lect(jg1+2) = -999
  129.           endif
  130.           jg1 = jg1 + 2
  131.         END DO
  132. c-dbg        write(ioimp,*) ISPCHO,jg1,mlenti.lect(/1)
  133.         if (jg1.ne.mlenti.lect(/1)) call erreur(5)
  134.         ISSQHO = mlenti
  135.  
  136.         ISAUHO = 2
  137.  
  138. C= 4 = ECRITURE EFFECTIVE DES MAILLAGES = SAUVER =======================
  139.       ELSE IF (iopt .EQ. 4) THEN
  140. c-dbg        write(ioimp,*) 'HHOPIL(4) :',isauho,ient1,ient2
  141. c-dbg        IF (ISAUHO.NE.2.AND.isauho.ne.0) write(ioimp,*) 'Attention ?'
  142.         IOSAU = ient1
  143.         IFORM = ient2
  144.         NMH = 3
  145.         ILENA(1) = ISAUHO
  146.         ILENA(2) = 0
  147.         ILENA(3) = 0
  148.         IF (ISAUHO.EQ.2) THEN
  149.           ILENA(2) = ISPCHO
  150.           ILENA(3) = ISPFHO
  151.         ENDIF
  152.         CALL ECDIFE(IOSAU,NMH,ILENA,IFORM)
  153. c-dbg        write(ioimp,*) 'SAUve hHO :',(ilena(i),i=1,nmh)
  154.  
  155.         IF (ISAUHO.NE.2) RETURN
  156.         NMH    = ISPCHO
  157.         mlenti = ISCEHO
  158.         CALL ECDIFE(IOSAU,NMH,mlenti.lect(1),IFORM)
  159.         NMH    = ISPFHO
  160.         mlenti = ISSQHO
  161.         CALL ECDIFE(IOSAU,NMH,mlenti.lect(1),IFORM)
  162.  
  163. C= 5 = LECTURE EFFECTIVE DES MAILLAGES = REST ==========================
  164.       ELSE IF (iopt .EQ. 5) THEN
  165. c-dbg        write(ioimp,*) 'HHOPIL(5) :',isauho,ient1,ient2
  166.         IORES = ient1
  167.         IFORM = ient2
  168.         NMH = 3
  169.         CALL LFCDIE(IORES,NMH,ILENA,iretou,IFORM)
  170.         IF (iretou.NE.0) THEN
  171.           write(ioimp,*) 'Erreur lors de la lecture'
  172.           RETURN
  173.         ENDIF
  174. c-dbg        write(ioimp,*) 'RESt hHO :',(ilena(i),i=1,nmh)
  175.         ISAUHO = ILENA(1)
  176.         IF (ISAUHO.NE.2) RETURN
  177.  
  178.         jg = ILENA(2)
  179.         SEGINI,mlenti
  180.         CALL LFCDIE(IORES,jg,mlenti.lect(1),iretou,IFORM)
  181.         IF (iretou.NE.0) THEN
  182.           write(ioimp,*) 'Erreur lors de la lecture'
  183.           RETURN
  184.         ENDIF
  185. c-dbg        write(ioimp,*) 'RESt hHO :',(lect(i),i=1,jg)
  186.         ISCEHO = mlenti
  187.  
  188.         jg = ILENA(3)
  189.         SEGINI,mlenti
  190.         CALL LFCDIE(IORES,jg,mlenti.lect(1),iretou,IFORM)
  191.         IF (iretou.NE.0) THEN
  192.           write(ioimp,*) 'Erreur lors de la lecture'
  193.           RETURN
  194.         ENDIF
  195. c-dbg        write(ioimp,*) 'RESt hHO :',(lect(i),i=1,jg)
  196.         ISSQHO = mlenti
  197.         jg1 = 0
  198.         IDIHHO = mlenti.lect(jg1+1)
  199.         IFOHHO = mlenti.lect(jg1+2)
  200.         NUFHHO = mlenti.lect(jg1+3)
  201.         NFAHHO = mlenti.lect(jg1+4)
  202.         NUCHHO = mlenti.lect(jg1+5)
  203.         NCEHHO = mlenti.lect(jg1+6)
  204.         NISFHO = mlenti.lect(jg1+7)
  205.         NISCHO = mlenti.lect(jg1+8)
  206.         jg1 = jg1 + 8
  207.         DO i = 0, NFAMAX
  208.           NBFHHO(i) = mlenti.lect(jg1+1+i)
  209.         END DO
  210.         jg1 = jg1 + 1+NFAMAX
  211.         DO i = 0, NCEMAX
  212.           NBCHHO(i) = mlenti.lect(jg1+1+i)
  213.         END DO
  214.         jg1 = jg1 + 1+NCEMAX
  215.         DO i = 1, NFAMAX
  216.           mlent2 = mlenti.lect(jg1+1)
  217.           if (mlent2.NE.-999) then
  218.             jg = 2
  219.             segini,mlent2
  220.             mlent2.lect(1) = mlenti.lect(jg1+1)
  221.             mlent2.lect(2) = mlenti.lect(jg1+2)
  222.             segdes,mlent2
  223.           endif
  224.           LOFHHO(i) = mlent2
  225.           jg1 = jg1 + 2
  226.         END DO
  227.         if (jg1.ne.mlenti.lect(/1)) call erreur(5)
  228.  
  229. C= 6 = STOCKAGE DES MAILLAGES = RESTITUER ==============================
  230.       ELSE IF (iopt .EQ. 6) THEN
  231.         NIVEAU = ient1 + 1
  232. c-dbg        write(ioimp,*) 'HHOPIL(6) :',isauho,niveau
  233.         IF (NIVEAU.LT.26) RETURN
  234.         IF (ISAUHO .NE. 2) RETURN
  235.         ICOLAC = ient2
  236.         itlac1 = icolac.KCOLA(1)
  237.         ilisse = icolac.ILISSG
  238.         iun    = 1
  239. C*        SEGACT,ilisse*MOD <- Fait en amont de l'appel 
  240.         mlenti = ISCEHO
  241.         SEGACT,mlenti*MOD
  242.         jg1 = 4 + NFAMAX + NCEMAX
  243. c-dbg        if (jg1.ne.ISPCHO) write(ioimp,*) 'HHOPIL(6) : ISPCHO ??'
  244.         DO i = 1, jg1
  245.           ip = mlenti.lect(i)
  246.           IF (ip.GT.0) then
  247.             mlenti.lect(i) = itlac1.itlac(ip)
  248.           ELSE
  249.             mlenti.lect(i) = 0
  250.           ENDIF
  251.         END DO
  252.  
  253.         jg1 = 0
  254.         MSQHHO = mlenti.lect(jg1+1)
  255.         MCEHHO = mlenti.lect(jg1+2)
  256.         MPFHHO = mlenti.lect(jg1+3)
  257.         MPCHHO = mlenti.lect(jg1+4)
  258.         jg1 = jg1 + 4
  259.         DO i = 1, NFAMAX
  260.           MAFHHO(i) = mlenti.lect(jg1+i)
  261.         END DO
  262.         jg1 = jg1 + NFAMAX
  263.         DO i = 1, NCEMAX
  264.           MACHHO(i) = mlenti.lect(jg1+i)
  265.         END DO
  266.         jg1 = jg1 + NCEMAX
  267.  
  268.         ISSQHO = mlenti
  269.         ISPCHO = jg1
  270.  
  271.         IRESHO = 1
  272.  
  273. C= 9 = REMISE A ZERO ET MENAGE DE SEGMENTS =============================
  274. c* Remise a zero et Menage de segments
  275.       ELSE IF (iopt.EQ.9) THEN
  276.         mlenti = ISSQHO
  277.         IF (mlenti.GT.0) SEGSUP,mlenti
  278.         mlenti = ISCEHO
  279.         IF (mlenti.GT.0) SEGSUP,mlenti
  280.  
  281.         ISAUHO = -99
  282.         IRESHO = -99
  283.         ISSQHO = -99
  284.         ISCEHO = -99
  285.         ISPFHO = 0
  286.         ISPCHO = 0
  287.  
  288. C= . = OPTION NON PREVUE ===============================================
  289.       ELSE
  290.         write(ioimp,*) 'HHOPIL : option ',iopt,' inconnue'
  291.         call erreur(5)
  292.       ENDIF
  293.  
  294. c-dbg      write(ioimp,*) 'HHOPIL S(',iopt,') :',ISAUHO,IRESHO,
  295. c-dbg     &               '-',ISSQHO,ISCEHO,ISPFHO,ISPCHO
  296.  
  297.       RETURN
  298.       END
  299.  
  300.  
  301.  

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