C CLI252 SOURCE OF166741 24/12/13 21:15:36 12097 SUBROUTINE CLI252(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM, & ICHPVO,ICHPSU,LRECP,LRECV, & IROC,IVITC,IPC,IYC,ICHLIM,ILIINC,ILIINP,IJAC,IJACO) C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : CLI252 C C DESCRIPTION : Subroutine appellée par CLIM22 C Jacobian for 'OUTP ' C C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) C C AUTEUR : S. Kudriakov, DEN/DM2S/SFME/LTMF C C************************************************************************ C C APPELES (Calcul) : C C************************************************************************ C C HISTORIQUE (Anomalies et modifications éventuelles) C C HISTORIQUE : C C************************************************************************ C IMPLICIT INTEGER(I-N) INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC & ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO & ,NGF,NGC,NLF,NLC,NLCB & ,ILIINC,ILIINP,IJAC,II,JJ & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE & ,NSP,I, IYC,J, LRECP,LRECV,KV REAL*8 VOLU,SURF,RC,PC,UXC,UYC,CNX,CNY,CTX,CTY & ,PF,COEF REAL*8 WVEC_L(4), WVEC_R(4), NVECT(2), TVECT(2) CHARACTER*(8) TYPE -INC PPARAM -INC CCOPTIO -INC SMLMOTS -INC SMELEME POINTEUR MELEFC.MELEME -INC SMLENTI POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI -INC SMCHPOI POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL, & MPVC.MPOVAL, MPPC.MPOVAL, MPLIM.MPOVAL, MPYC.MPOVAL -INC SMMATRIK POINTEUR CELL.IZAFM C------------------------------------------------------- -INC SMLREEL POINTEUR MLRECP.MLREEL, MLRECV.MLREEL C------------------------------------------------------- C********* Les Jacobians ****************************** C------------------------------------------------------- SEGMENT JACEL REAL*8 JAC(3+NSP,3+NSP) ENDSEGMENT POINTEUR JLL.JACEL,JPL.JACEL,JTL.JACEL,JTT.JACEL C------------------------------------------------------------- C******* Les fractionines massiques ************************** C------------------------------------------------------------- SEGMENT FRAMAS REAL*8 YET(NSP) ENDSEGMENT POINTEUR YC.FRAMAS C------------------------------------------------------- C********** Les CP's and CV's *********************** C------------------------------------------------------- SEGMENT GCONST REAL*8 GC(NSP) ENDSEGMENT POINTEUR CP.GCONST, CV.GCONST C---------------------------------------------------- C**** KRIPAD pour la correspondance global/local C---------------------------------------------------- CALL KRIPAD(MELEMC,MLEMC) CALL KRIPAD(MELECB,MLEMCB) CALL KRIPAD(MELEMF,MLEMF) C---------------------------------------------------- C**** CHPOINTs de la table DOMAINE C---------------------------------------------------- CALL LICHT(INORM,MPNORM,TYPE,ICEL) CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) C---------------------------------------------------- C**** CHPOINTs des variables C---------------------------------------------------- CALL LICHT(IROC,MPRC,TYPE,ICEL) CALL LICHT(IVITC,MPVC,TYPE,ICEL) CALL LICHT(IPC,MPPC,TYPE,ICEL) CALL LICHT(IYC,MPYC,TYPE,ICEL) CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) C-------------------------------------------------------- C**** Boucle sur le face pour le calcul des invariants de C Riemann et du flux C-------------------------------------------------------- SEGACT MELEFC NFAC=MELEFC.NUM(/2) C--------------------------------- C**** Objet MATRIK C--------------------------------- NRIGE = 7 NMATRI = 1 NKID = 9 NKMT = 7 C--------------------------------- SEGINI MATRIK IJACO = MATRIK MATRIK.IRIGEL(1,1) = MELRES MATRIK.IRIGEL(2,1) = MELRES C--------------------------------- C**** Matrice non symetrique C--------------------------------- MATRIK.IRIGEL(7,1) = 2 C--------------------------------- NBME = (3+NSP)*(3+NSP) NBSOUS = 1 SEGINI IMATRI IF(IJAC.EQ.1)THEN MLMOTS=ILIINC ELSEIF(IJAC.EQ.2)THEN MLMOTS=ILIINP ENDIF SEGACT MLMOTS MATRIK.IRIGEL(4,1) = IMATRI C------------------------------------------- DO 1 J=1,(NSP+3) KV=(J-1)*(3+NSP) IMATRI.LISPRI(KV+1) = MLMOTS.MOTS(1) IMATRI.LISPRI(KV+2) = MLMOTS.MOTS(2) IMATRI.LISPRI(KV+3) = MLMOTS.MOTS(3) IMATRI.LISPRI(KV+4) = MLMOTS.MOTS(4) DO 2 I=1,(NSP-1) IMATRI.LISPRI(KV+4+I) = MLMOTS.MOTS(4+I) 2 CONTINUE 1 CONTINUE C----------------------------------------------- SEGDES MLMOTS MLMOTS=ILIINC SEGACT MLMOTS C----------------------------------------------- DO 3 J=1,(NSP+3) KV=(J-1)*(3+NSP) IMATRI.LISDUA(KV+1) = MLMOTS.MOTS(j) IMATRI.LISDUA(KV+2) = MLMOTS.MOTS(j) IMATRI.LISDUA(KV+3) = MLMOTS.MOTS(j) IMATRI.LISDUA(KV+4) = MLMOTS.MOTS(j) DO 4 I=1,(NSP-1) IMATRI.LISDUA(KV+4+I) = MLMOTS.MOTS(j) 4 CONTINUE 3 CONTINUE C----------------------------------------------- C----------------------------------------------- SEGDES MLMOTS NBEL = NFAC NBSOUS = 1 NP = 1 MP = 1 C----------------------------------------------------------- C----------------------------------------------------------- DO 5 I=1,NBME SEGINI CELL IMATRI.LIZAFM(1,I) = CELL 5 CONTINUE C--------------------------------- C**** Fin definition MATRIK C--------------------------------- DO IFAC=1,NFAC,1 NGF=MELEFC.NUM(1,IFAC) NGC=MELEFC.NUM(2,IFAC) NLF=MLEMF.LECT(NGF) NLC=MLEMC.LECT(NGC) NLCB=MLEMCB.LECT(NGF) VOLU=MPVOL.VPOCHA(NLC,1) SURF=MPSURF.VPOCHA(NLF,1) C In CASTEM les normales sont sortantes CNX=MPNORM.VPOCHA(NLF,1) CNY=MPNORM.VPOCHA(NLF,2) CTX=-1.0D0*CNY CTY=CNX C---------------------------------------------- SEGINI CP, CV MLRECP = LRECP MLRECV = LRECV SEGACT MLRECP, MLRECV DO 10 I=1,(NSP-1) CP.GC(I)=MLRECP.PROG(I) CV.GC(I)=MLRECV.PROG(I) 10 CONTINUE CP.GC(NSP)=MLRECP.PROG(NSP) CV.GC(NSP)=MLRECV.PROG(NSP) C--------------------------------- C Variables au centre C--------------------------------- RC=MPRC.VPOCHA(NLC,1) PC=MPPC.VPOCHA(NLC,1) UXC=MPVC.VPOCHA(NLC,1) UYC=MPVC.VPOCHA(NLC,2) SEGINI YC SEGACT MPYC DO 100 I=1,(NSP-1) YC.YET(I)=MPYC.VPOCHA(NLC,I) 100 CONTINUE C--------------------------------- C Variables à la face C--------------------------------- PF=MPLIM.VPOCHA(NLCB,1) C------------------------------ C******* Derivatives C------------------------------ wvec_l(1)=RC wvec_l(2)=UXC wvec_l(3)=UYC wvec_l(4)=PC C-------------------------- wvec_r(1)=RC wvec_r(2)=UXC wvec_r(3)=UYC wvec_r(4)=PF C-------------------------- nvect(1)=CNX nvect(2)=CNY tvect(1)=CTX tvect(2)=CTY call copmsp(nsp,jpl,jll,wvec_l,wvec_r,nvect,tvect, & mpyc,lrecp,lrecv,nlc,nlc) C----------------------------------------------- COEF=-SURF/VOLU C---------------------------------------- JTT=JLL JTL=JPL SEGACT JTT SEGACT JTL C---------------------------------------- C---------------------------------------------------------------- C******* Jacobian with respect to conservative variables C---------------------------------------------------------------- IF(IJAC.EQ.1)THEN DO 9 II = 1,(3+NSP) DO 15 JJ = 1,(3+NSP) KV = (II-1)*(3+NSP) C---------------------------------- CELL = IMATRI.LIZAFM(1,KV+JJ) CELL.AM(IFAC,1,1) = JTT.JAC(II,JJ)*COEF 15 CONTINUE 9 CONTINUE ELSEIF(IJAC.EQ.2)THEN DO 20 II = 1,(3+NSP) DO 25 JJ = 1,(3+NSP) KV = (II-1)*(3+NSP) C---------------------------------- CELL = IMATRI.LIZAFM(1,KV+JJ) CELL.AM(IFAC,1,1) = JTL.JAC(II,JJ)*COEF 25 CONTINUE 20 CONTINUE ENDIF c-------------------------------------------------- ENDDO C SEGDES MELEFC C SEGSUP MLEMC SEGSUP MLEMCB SEGSUP MLEMF C SEGDES MPNORM SEGDES MPVOL SEGDES MPSURF SEGDES MPRC SEGDES MPPC SEGDES MPVC SEGDES MPYC SEGDES MPLIM SEGDES YC c SEGDES YF SEGDES CP SEGDES CV SEGDES JTL SEGDES JTT c SEGDES WL c SEGDES DYDG1, DFRYG1, c & DG1DY, DGDYC SEGDES MATRIK DO 80 II=1,NBME CELL = IMATRI.LIZAFM(1,II) SEGDES CELL 80 CONTINUE SEGDES IMATRI C--------------------------------------------- 9999 CONTINUE RETURN END