c************************************************************** SUBROUTINE csv_tr c routine PRIVATE du module mod_cesam c écritures csv dans les sorties ASCII *_TR.csv c Auteur : P.Morel, Laboratoire Lagrange, OCA, cesam2k c----------------------------------------------------------------- USE mod_kind USE mod_donnees, ONLY: en_m23, g, gmsol, m_ch, nvth, pi, pnzc, rsol USE mod_numerique, ONLY: bsp1dn, csv_write, inside, no_croiss USE mod_static, ONLY: mmtI USE mod_variables, ONLY: age, knotc, lconv, lim, lstar, log10_teff, 1 mc, mct, model_num, mstar, M_iner, MI_atm, n_ch, n_ch_t, n_qs, 2 rstar, r_zc, S_entro, S_0atm, tot_conv, t_conv, vth IMPLICIT NONE REAL (kind=dp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: v_tr REAL (kind=dp), SAVE, ALLOCATABLE, DIMENSION(:) :: q_tr, q_trt REAL (kind=dp), DIMENSION(nvth) :: dfvth, fvth REAL (kind=dp), DIMENSION(5) :: dv_zc, mv_zc, m_in, ro_zc, 1 t_zc, rv_zc, r_rad REAL (kind=dp), DIMENSION(5) :: entro REAL (kind=dp), SAVE :: cte7, cte_tr, c_tr REAL (kind=dp) :: bid, pc, roc, s_atm, s_0, teff, tc INTEGER, PARAMETER :: m_tr=2 INTEGER, DIMENSION(5) :: iconv INTEGER, SAVE :: lq=1, knot_tr INTEGER :: i, lim_tr, n_tr LOGICAL, SAVE :: init=.TRUE. c--------------------------------------------------------------- 2000 FORMAT(8es10.3) IF(init)THEN init=.FALSE. cte7=(gmsol/rsol**2)**2 cte_tr=4.d0/3.d0*pi*g !constante du C de Tristan ENDIF c interpolation des variables thermodynamiques en utilisant n_ch et vth c l'appel à tab_vth est fait dans cesam.f n_tr=n_ch c allocations pour écritures personnalisée des fichiers ASCII *.TR IF(ALLOCATED(q_tr))THEN IF(n_ch /= n_ch_t)THEN DEALLOCATE(q_tr, q_trt, v_tr) ALLOCATE(q_tr(n_tr),q_trt(n_tr+m_tr),v_tr(3,n_tr)) ENDIF ELSE ALLOCATE(q_tr(n_tr),q_trt(n_tr+m_tr),v_tr(3,n_tr)) ENDIF c tabulation de N2 n_tr=n_ch DO i=1,n_tr c utilisation de la tabulation vth base des mc (m**2/3=nu) c fvth(1)=lnP, fvth(2)=lnT, fvth(5)=ln ro, c fvth(6)=cp, fvth(7)=delta, fvth(8)=gamma1, fvth(9)=ln µ, c fvth(10)=ln kap, fvth(11)=degene c en m^2/3 : fvth(3)=r**2, fvth(4)=l**2/3, dfvth(3)=dr^2/dnu c en m^1/3 : fvth(3)=r, fvth(4)=l, dfvth(3)=dr/dnu CALL bsp1dn(nvth,vth,mc,mct,n_ch,m_ch,knotc,.TRUE.,mc(i), 1 lq,fvth,dfvth) IF(no_croiss)PRINT*,'Pb. 1 in csv_tr' v_tr(2,i)=fvth(5) !ln rho c au centre IF(i == 1)THEN v_tr(1,i)=0.d0 v_tr(3,i)=0.d0 !m q_tr(i)=0.d0 !r bid=dfvth(5)/dfvth(1)-1.d0/fvth(8) pc=EXP(fvth(1)) ; tc=EXP(fvth(2)) ; roc=EXP(fvth(5)) c_tr=cte_tr*roc*SQRT(roc/pc*ABS(bid))*SIGN(1.d0,bid) ELSE v_tr(1,i)=cte7*mc(i)**3/fvth(3)**2*EXP(fvth(5))/EXP(fvth(1))* 1 (dfvth(5)/dfvth(1)-1.d0/fvth(8)) !N2 v_tr(3,i)=SQRT(mc(i)**3) !m IF(en_m23)THEN q_tr(i)=SQRT(fvth(3)) !r ELSE q_tr(i)=fvth(3) !r v_tr(1,i)=v_tr(1,i)/fvth(3)**2 !/r^2 ENDIF ENDIF c PRINT*,'i=',i ; WRITE(*,2000)mc(i),q_tr(i),v_tr(:,i) ENDDO c PAUSE'csv_tr 1' c initialisations dv_zc=0.d0 ; ro_zc=0.d0 ; mv_zc=0.d0 ; rv_zc=0.d0 ; iconv=0 c modèle totalement convectif: lim=1, jlim(1)=n_qs, lconv(1)=.FALSE. c nzc=1, convd(1)=1, convf(1)=nc_tmp c modèle totalement radiatif: lim=0, jlim(i)=-100, lconv(i)=.FALSE. c nzc=0, convd(1)=nc_tmp, convf(0)=1 IF(tot_conv)THEN iconv(1)=1 lim_tr=0 ELSE lim_tr=lim c tabulation de v_tr=N2 et ln rho en fonction de q_tr=R CALL bsp1dn(3,v_tr,q_tr,q_trt,n_tr,m_tr,knot_tr,.FALSE., 1 q_tr(1),lq,fvth,dfvth) IF(no_croiss)PRINT*,'Pb. 2 in csv_tr' c lconv(i)=0 si début d'une ZC en r_zc(i), lconv(i)=1 si fin d'une ZC DO i=1,MIN(5,lim) IF(lconv(i))THEN iconv(i)=0 ELSE iconv(i)=1 ENDIF c en r_zc(i) dN2 / dr et interpolation de ln rho, m CALL bsp1dn(3,v_tr,q_tr,q_trt,n_tr,m_tr,knot_tr,.TRUE., 1 r_zc(i),lq,fvth,dfvth) IF(no_croiss)PRINT*,'Pb. 3 in csv_tr' c rho, r, m en r_zc(i) ro_zc(i)=MAX(EXP(fvth(2)),1.d-9) !limitation rv_zc(i)=inside(0.d0,1.d0,r_zc(i)/rstar) mv_zc(i)=inside(0.d0,1.d0,fvth(3)/mstar) c PRINT*,'r_zc(i),dv_tr(i),fvth(1)',i c WRITE(*,2000)r_zc(i),dv_tr(i),fvth(1) ENDDO c PAUSE'csv_tr' c M et R à la limite de l'enveloppe différent de M* et R* (1d-8 et 1.d-4) c delta~0.03 R* bid=0.03d0*q_tr(n_tr) c recherche du rayon r_rad(i) du coté radiatif de la limite ZR/ZC r_rad=-100.d0 DO i=1,MIN(5,lim) IF(lconv(i))THEN r_rad(i)=MAX(0.d0,r_zc(i)-bid) !début de ZC ELSE r_rad(i)=MIN(q_tr(n_tr),r_zc(i)+bid) !fin de ZC ENDIF CALL bsp1dn(3,v_tr,q_tr,q_trt,n_tr,m_tr,knot_tr,.TRUE., 1 r_rad(i),lq,fvth,dfvth) !fvth,dfvth tableaux de travail dv_zc(i)=SQRT(r_zc(i)/bid)*fvth(1) ENDDO c WRITE(*,2000)r_rad ; PAUSE'csv_tr 2' ENDIF !tot_conv c teff teff=10.d0**log10_teff c Moments d'inertie du centre à chaque limite ZR/ZC, temps de convection m_in=M_iner(1:5) t_zc=t_conv(1:5) entro=S_entro(1:5) s_0=S_0atm(0) s_atm=S_0atm(1) c écritures sur le fichier mon_modele.TR.csv c list_TR(1)='model_num,age_Ma,Mstar_sun,Rstar_sun,Teff_K,' c list_TR(2)='lum_sun,Pc_cgs,Tc_K,Roc_cgs,C_tr,Mmt_In,lim,' c list_TR(3)='lconv1,lconv2,lconv3,lconv4,lconv5,' c list_TR(4)='r_zc1,r_zc2,r_zc3,r_zc4,r_zc5,' c list_TR(5)='m_zc1,m_zc2,m_zc3,m_zc4,m_zc5,' c list_TR(6)='ro_zc1,ro_zc2,ro_zc3,ro_zc4,ro_zc5,' c list_TR(7)='dv_zc1,dv_zc2,dv_zc3,dv_zc4,dv_zc5' c list_TR(8)='Mmt_zc1,Mmt_zc2,Mmt_zc3,Mmt_zc4,Mmt_zc5,' c list_TR(9)='Mmt_atm,t_zc1,t_zc2,t_zc3,t_zc4,t_zc5,S_ctr,' c list_TR(10)='S_ent1,S_ent2,S_ent3,S_ent4,S_ent5,S_atm' CALL csv_write(56,model_num,.FALSE.) CALL csv_write(56,age,.FALSE.) CALL csv_write(56,REAL(mstar,sp),.FALSE.) CALL csv_write(56,REAL(rstar,sp),.FALSE.) CALL csv_write(56,REAL(teff,sp),.FALSE.) CALL csv_write(56,REAL(lstar,sp),.FALSE.) CALL csv_write(56,REAL(pc,sp),.FALSE.) CALL csv_write(56,REAL(tc,sp),.FALSE.) CALL csv_write(56,REAL(roc,sp),.FALSE.) CALL csv_write(56,REAL(c_tr,sp),.FALSE.) CALL csv_write(56,REAL(mmtI,sp),.FALSE.) CALL csv_write(56,lim_tr,.FALSE.) CALL csv_write(56,iconv,.FALSE.) CALL csv_write(56,REAL(rv_zc,sp),.FALSE.) CALL csv_write(56,mv_zc,.FALSE.) CALL csv_write(56,REAL(ro_zc,sp),.FALSE.) CALL csv_write(56,REAL(dv_zc,sp),.FALSE.) CALL csv_write(56,REAL(m_in,sp),.FALSE.) CALL csv_write(56,REAL(MI_atm,sp),.FALSE.) CALL csv_write(56,REAL(t_zc,sp),.FALSE.) CALL csv_write(56,REAL(s_0,sp),.FALSE.) CALL csv_write(56,REAL(entro,sp),.FALSE.) c dernière écriture par modèle CALL csv_write(56,REAL(s_atm,sp),.TRUE.) c WRITE(*,2000)mstar,rstar c WRITE(*,2000)mv_zc ; WRITE(*,2000)rv_zc c WRITE(*,2000)ro_zc ; WRITE(*,2000)dv_zc c WRITE(*,2000)m_in ; WRITE(*,2000)t_zc c WRITE(*,2000)M_iner(1:5) ; WRITE(*,2000)t_conv(1:5) c WRITE(*,2000)S_entro(1:6) c PAUSE'csv_tr 3' RETURN END SUBROUTINE csv_tr