c************************************************************ SUBROUTINE lit_binaire(chaine,dt) c subroutine public du module mod_exploit c lecture d'un fichier binaire c on vérifie l'existence du fichier *_.don puis on le lit, c on recherche le fichier *_B.dat, en cas d'échec le fichier *_B.rep c en cas d'échec on demande d'entrer un autre fichier c Auteur: P.Morel, Département J.D. Cassini, O.C.A., CESAM2k c----------------------------------------------------------------- USE mod_donnees, ONLY : alpha, aradia, clight, diffusion, 1 en_m23, f_eos, f_opa, g, Krot, lim_ro, lit_nl, lsol, 2 msol, mtot, m_ch, m_qs, m_rot, m_tds, nchim, ne, 3 nom_abon, nom_atm, nom_conv, nom_ctes, nom_des, nom_diffm, 4 nom_difft, nom_diffw, nom_elem, nom_etat, nom_fich2, nom_nuc, 5 nom_nuc_cpl, nom_opa, nom_output, nom_pertm, nom_pertw, nom_tdetau, 6 nrot, ord_qs, ord_rot, pi, precision, rot_solid, rsol, r_qs, 7 w_rot, zi USE mod_kind USE mod_variables, ONLY : age, bp, chim, chim_gram, dim_qs, dim_rot, 1 jlim, knot, knotc, knotr, knot_tds, lconv, lim, mc, mct, model_num, 2 mrot, mrott, mstar, mw_tot, m_zc, m_stat, n_ch, n_qs, n_rot, n_tds, 3 q, qt, rota, rstar, r_ov, r_zc, r_stat, tds, wrot, x_tds, xt_tds IMPLICIT NONE REAL (kind=dp), INTENT(out) :: dt REAL (kind=dp) :: dts INTEGER :: cas, dim_ch CHARACTER (len=2) :: precisione CHARACTER (len=20) :: nom_convp, nom_nucp, nom_nuc_cplp, nom_etatp CHARACTER (len=50), DIMENSION(8) :: f_eosp, f_opap CHARACTER (len=50) :: nom_opap CHARACTER (len=80) , INTENT(out):: chaine LOGICAL :: ok c----------------------------------------------------------------- 2000 FORMAT(8es10.3) c lecture du fichier *.don WRITE(*,20) 20 FORMAT(/,'Entrer le nom générique du modèle, Ex: soleil') READ*,nom_fich2 ; WRITE(*,1)TRIM(nom_fich2) 1 FORMAT('Lecture en binaire des données du modèle: ',a) c vérification de l'existence du fichier *.don c chaine=TRIM(nom_fich2)//'.don' c INQUIRE(file=TRIM(chaine),exist=ok) c IF(ok)THEN c OPEN(unit=30,form='formatted',status='old',file=TRIM(chaine)) c ELSE c PRINT*,'Arrêt: fichier de données inconnu: ',TRIM(chaine) c STOP c ENDIF c lecture du fichier de données CALL lit_nl(wrot) c on garde, pour l'utiliser, la physique du *.don f_eosp=f_eos ; f_opap=f_opa nom_opap=nom_opa ; nom_convp=nom_conv ; nom_nucp=nom_nuc nom_nuc_cplp=nom_nuc_cpl ; nom_etatp=nom_etat c identification du fichier binaire à lire PRINT* PRINT*,'Pour arrêter taper 0' PRINT*,'Pour lire un fichier binaire *_B.pms, entrer 1' PRINT*,'Pour lire un fichier binaire *_B.zams, entrer 2' PRINT*,'Pour lire un fichier binaire *_B.hom, entrer 3' PRINT*,'Pour lire un fichier binaire *_B.post, entrer 4' PRINT*,'Pour lire un fichier binaire *_B.cohe, entrer 5' PRINT*,'Pour lire un fichier binaire *_B.coca, entrer 6' PRINT*,'Pour lire un fichier binaire *_B.cone, entrer 7' PRINT*,'Pour lire un fichier binaire *_B.coox, entrer 8' PRINT*,'Pour lire un fichier binaire *_B.cosi, entrer 9' PRINT*,'Pour lire un fichier binaire *_B.rep, entrer 10' PRINT*,'Pour lire un fichier binaire *_B.dat, entrer 11' PRINT*,'Pour lire un fichier binaire ????_B.???, entrer 12' READ*,cas SELECT CASE(cas) CASE(0) PRINT*,'ARRET' ; STOP CASE(1) chaine=TRIM(nom_fich2)//'_B.pms' CASE(2) chaine=TRIM(nom_fich2)//'_B.zams' CASE(3) chaine=TRIM(nom_fich2)//'_B.hom' CASE(4) chaine=TRIM(nom_fich2)//'_B.post' CASE(5) chaine=TRIM(nom_fich2)//'_B.cohe' CASE(6) chaine=TRIM(nom_fich2)//'_B.coca' CASE(7) chaine=TRIM(nom_fich2)//'_B.cone' CASE(8) chaine=TRIM(nom_fich2)//'_B.coox' CASE(9) chaine=TRIM(nom_fich2)//'_B.cosi' CASE(10) chaine=TRIM(nom_fich2)//'_B.rep' CASE(11) chaine=TRIM(nom_fich2)//'_B.dat' CASE(12) PRINT*,'entrer le nom COMPLET du fichier binaire Ex: bidLe.xV_Q' READ(*,2)chaine 2 FORMAT(a) CASE DEFAULT PRINT*,'Erreur, vous avez saisi : ',cas ; STOP END SELECT INQUIRE(file=TRIM(chaine),exist=ok) IF(ok)THEN PRINT*,'On utilise le fichier binaire: ',TRIM(chaine) ELSE PRINT*,'Arrêt: fichier binaire inconnu: ',TRIM(chaine) ; STOP ENDIF c lecture des paramètres dans le fichier binaire original OPEN(unit=4,form='unformatted',status='old',file=chaine) READ(4)ne,m_qs,n_qs,knot,nchim,n_ch,m_ch,knotc,Krot,nrot, 1 n_rot,m_rot,knotr,n_tds,knot_tds c PRINT*,'knotc,n_ch)',knotc,n_ch c reprise du modèle, on ajuste les dim. à celles du modèle repris ord_qs=m_qs+r_qs ; dim_qs=knot-ord_qs ; dim_ch=knotc-m_ch ord_rot=m_rot+r_qs ; dim_rot=knotr-ord_rot ; m_tds=knot_tds-n_tds ALLOCATE(bp(ne,dim_qs),q(n_qs),qt(knot),nom_elem(nchim), 1 chim(nchim,dim_ch),mc(n_ch),mct(knotc),mrot(n_rot), 2 mrott(knotr),tds(1,knot_tds-m_tds),x_tds(n_tds), 3 xt_tds(knot_tds),m_stat(n_qs),r_stat(n_qs),rota(nrot,dim_rot)) REWIND(unit=4) READ(4)ne,m_qs,n_qs,knot,nchim,n_ch,m_ch,knotc,Krot,nrot,n_rot, 1 m_rot,knotr,n_tds,knot_tds,mtot,alpha,w_rot, 2 lim_ro,diffusion,rot_solid,precisione,en_m23,f_eos, 3 f_opa,nom_ctes,nom_pertm,nom_pertw,nom_tdetau,nom_atm, 4 nom_conv,nom_nuc,nom_nuc_cpl,nom_diffm,nom_difft,nom_diffw, 5 nom_etat,nom_opa,nom_elem, 6 bp,q,qt,chim,mc,mct,rota,mrot,mrott,tds,x_tds,xt_tds,m_stat, 7 r_stat,m_zc,r_zc,r_ov,age,dt,dts,mstar,rstar,mw_tot,wrot,jlim, 8 lconv,lim,model_num CLOSE(unit=4) c WRITE(*,2000)mc(1:8) ; WRITE(*,2000)mct(1:8) c WRITE(*,2000)mct(knotc-8:knotc) c PRINT*,nom_etat,nom_opa,nom_elem c WRITE(*,2000)m_zc c WRITE(*,2000)r_zc c WRITE(*,2000)r_ov c WRITE(*,2000)age,dt c WRITE(*,2000)mstar,rstar c WRITE(*,2000)mw_tot,wrot c PRINT*,lim, model_num c PRINT*,jlim(1:lim) ; PRINT*,lconv(0:lim) c PRINT*,jlim ; PRINT*,lconv precision(1:2)=precisione(1:2) c on utilise la physique du *.don f_eos=f_eosp ; f_opa=f_opap nom_opa=nom_opap ; nom_conv=nom_convp ; nom_nuc=nom_nucp nom_nuc_cpl=nom_nuc_cplp ; nom_etat=nom_etatp c PRINT*,'Fin de lecture du fichier binaire: ',TRIM(chaine) WRITE(*,3)TRIM(chaine),age,model_num 3 FORMAT('Fin de lecture du fichier binaire: ',a,/,'age:',es10.3, 1 ', modèle n° ',i5,/) RETURN END SUBROUTINE lit_binaire