c********************************************************************** PROGRAM opalX_ascii_bin c lecture en ASCII, écriture en binaire de tables de l'EOS OPAL c pour OPAL 2001 c adaptation à CESAM de la routine readco du package OPAL_EOS c Auteur: P. Morel, Département J.D. Cassini, O.C.A. c CESAM2k c 15 10 97 : variables en double precision c adapter les noms des fichiers ASCII et binaire c fich(1)='eos_opal_190.data' et fich(1)='eos_opal_190.bin' c------------------------------------------------------------------- USE mod_kind IMPLICIT NONE INTEGER, PARAMETER :: mx=6, mv=10, nr=169, nt=191 REAL (kind=dp), DIMENSION(mx,mv,nt,nr) :: xz=1.d35 REAL (kind=dp), DIMENSION(nr,nt) :: alogr, t6list REAL (kind=dp), DIMENSION(mx,nr) :: rhogr REAL (kind=dp), DIMENSION(mx,6) :: frac REAL (kind=dp), DIMENSION(mx) :: moles, tmass, xin, zz REAL (kind=dp) :: dum INTEGER, DIMENSION(mx,nr) :: icycuse INTEGER :: i INTEGER, DIMENSION(nr) :: nta=(/ (191,i=1,92),190,189, 1 188,187,186,185,184,174,(134,i=101,104),(133,i=105,107), 2 (132,i=108,109),98,92,(85,i=112,113),(77,i=114,115),71, 3 (63,i=117,119),(59,i=120,121),53,51,(46,i=124,125), 4 (44,i=126,134),(38,i=135,137),(33,i=138,143),(29,i=144,159),27, 5 26,25,23,22,20,19,18,17,16 /) INTEGER, DIMENSION(10) :: index=(/ 1, 2, 3, 4, 5, 6, 7, 1 8, 9, 10 /) INTEGER :: iv, jcs, m, numtot CHARACTER (len=1) :: blank, oui CHARACTER (len=50) :: f_eos CHARACTER (len=80) :: chain LOGICAL :: ok c------------------------------------------------------------------- 2000 FORMAT(8es10.3) c read tables t6list=-100.d0 ; alogr=-100.d0 f_eos='EOSdata_H-He' INQUIRE(file=TRIM(f_eos),exist=ok) IF(.NOT.ok)THEN WRITE(*,10)TRIM(f_eos) 10 FORMAT('Fichier de données inconnu : ',a) chain=TRIM(f_eos)//'.gz' INQUIRE(file=TRIM(chain),exist=ok) IF(.NOT.ok)THEN WRITE(*,12)TRIM(chain) ; STOP 12 FORMAT('Fichier de données compressé inconnu : ',a) ELSE WRITE(*,11)TRIM(chain) 11 FORMAT('décompression du fichier ASCII de données : ',a) CALL system('gunzip '//TRIM(chain)) ENDIF ENDIF WRITE(*,1)TRIM(f_eos) 1 FORMAT('données ASCII prises dans le fichier: ',a,/, 1 'lecture, et c''est long, de ce fichier') OPEN(unit=60,file=TRIM(f_eos)) DO m=1,mx READ(60,2)xin(m),zz(m),moles(m),tmass(m) c WRITE(*,2000)xin(m),zz(m),moles(m),tmass(m) ; PAUSE'1' 2 FORMAT(3x,f6.4,3x,f12.9,11x,f10.7,17x,f10.7) c PRINT*,mx,m ; WRITE(*,2000)xin(m),zz(m),moles(m),tmass(m);PAUSE'2' READ(60,3)(frac(m,i),i=1,6) 3 FORMAT(21x,e14.7,4x,e14.7,3x,e11.4,3x,e11.4,3x,e11.4,4x,e11.4) READ(60,'(a)') blank DO jcs=1,nr READ(60,4)numtot,icycuse(m,jcs),dum,dum,rhogr(m,jcs) 4 FORMAT(2i5,2f12.7,17x,e15.7) IF(numtot /= jcs) THEN WRITE(*,'(" Data file incorrect: numtot,jcs= ",2i5)')numtot,jcs STOP ENDIF READ(60,'(a)') blank READ(60,'(a)') blank IF(icycuse(m,jcs) < nta(jcs))THEN WRITE (*,'("problem with data files: X=",f6.4," density=", 1 e14.4)')xin(m),rhogr(m,jcs) STOP ENDIF DO i=1,icycuse(m,jcs) IF(i > nta(jcs)) THEN READ(60,'(a)') blank ELSE READ(60,5)t6list(jcs,i),alogr(jcs,i),(xz(m,index(iv),i,jcs), 1 iv=1,9) 5 FORMAT(f9.5,1x,f6.2,3e13.5,6f8.4) c PRINT*,jcs,i ; WRITE(*,2000)t6list(jcs,i) ENDIF ENDDO READ(60,'(a)') blank READ(60,'(a)') blank READ(60,'(a)') blank ENDDO READ(60,'(a)') blank ENDDO PRINT*,'fin de lecture des tables OPAL' CLOSE(unit=60) CALL system('gzip '//TRIM(f_eos)) c nom du fichier de sortie en binaire f_eos='eos_opalX.bin' INQUIRE(file=TRIM(f_eos),exist=ok) IF(ok)THEN WRITE(*,13)TRIM(f_eos) 13 FORMAT('écrase-t-on, entrer o/n, le fichier : ',a) READ*,oui IF(oui /= 'o')STOP ELSE chain=TRIM(f_eos)//'.gz' INQUIRE(file=TRIM(chain),exist=ok) IF(ok)THEN WRITE(*,14)TRIM(chain) 14 FORMAT('écrase-t-on, entrer o/n, le fichier : ',a) READ*,oui IF(oui /= 'o')STOP CALL system('gunzip '//TRIM(chain)) ENDIF ENDIF WRITE(*,6)TRIM(f_eos) 6 FORMAT('début des écritures sur le fichier binaire: ',a) OPEN(unit=60,file=f_eos,form='unformatted',status='unknown') WRITE(unit=60)xz,t6list,alogr,rhogr,xin,zz,moles,tmass,frac,icycuse c WRITE(*,2000)(zz(i),i=1,mx) c pause'écriture en binaire' CLOSE(unit=60) ; CALL system('gzip '//TRIM(f_eos)) ; WRITE(*,15) 15 FORMAT('fin des écritures en binaire, test de relecture') CALL r_opal_bin ; PRINT*,'test de relecture réussi' STOP CONTAINS c********************************************************************** SUBROUTINE r_opal_bin c adaptation à CESAM de la routine readco du package OPAL_EOS c Auteur: P. Morel, Departement J.D. Cassini, O.C.A., Observatoire de Nice c CESAM4 c 15 10 97 : variables en double precision c..... The purpose of this SUBROUTINE is to READ the data tables c------------------------------------------------------------------- USE mod_kind IMPLICIT NONE INTEGER :: i,ntuse CHARACTER (len=80) :: fich INTEGER m,mf REAL (kind=dp) :: xz(mx,mv,nt,nr),t6list(nr,nt),rho(nr),t6a(nt),esk(nt,nr), 1 esk2(nt,nr),dfsx(mx),dfs(nt),dfsr(nr),xa(mx) COMMON/a/xz,t6list,rho,t6a,esk,esk2,dfsx,dfs,dfsr,m,mf,xa INTEGER iri(10),index(10),nta(nr) REAL (kind=dp) :: zz(mx) COMMON/b/zz,iri,index,nta REAL (kind=dp) :: epl(mx,nt,nr),xx(mx) COMMON/ee/epl,xx INTEGER :: icycuse(mx,nr) REAL (kind=dp) :: moles(mx),xin(mx),tmass(mx),rhogr(mx,nr),frac(mx,6), 1 alogr(nr,nt) COMMON/eee/rhogr,frac,alogr,moles,xin,tmass,icycuse SAVE c------------------------------------------------------------------ 2000 FORMAT(8es10.3) WRITE(2,1)TRIM(f_eos) ; WRITE(*,1)TRIM(f_eos) 1 FORMAT('données prises dans le fichier binaire: ',a) CALL system('gunzip '//TRIM(f_eos)) PRINT*,'décompression du fichier' CLOSE(unit=60) OPEN(unit=60,file=f_eos,form='unformatted') PRINT*,'lecture, des donnees EOS opal, et c''est long' READ(60)xz,t6list,alogr,rhogr,xin,zz,moles,tmass,frac,icycuse CLOSE(unit=60) WRITE(*,2)TRIM(f_eos) 2 FORMAT('recompression du fichier binaire EOS',a) CALL system('gzip '//TRIM(f_eos)) c WRITE(*,2000)(zz(i),i=1,mx) ; PAUSE'lecture du binaire' DO i=1,nt IF(t6list(1,i) == 0.0) THEN ntuse=i ELSE t6a(i)=t6list(1,i) ENDIF ENDDO DO i=2,nt dfs(i)=1.d0/(t6a(i)-t6a(i-1)) ENDDO rho(1)=rhogr(1,1) DO i=2,nr rho(i)=rhogr(1,i) ; dfsr(i)=1.d0/(rho(i)-rho(i-1)) endDO DO i=2,mx dfsx(i)=1.d0/(xx(i)-xx(i-1)) ENDDO PRINT*,'fin de lecture des données EOS opal en binaire' RETURN END SUBROUTINE r_opal_bin END program opalX_ascii_bin