*=*=*=*= headgrads.html =*=*=*=*
function headgrads(unit,file) IMPLICIT NONE c======================================================================= c c Frederic Hourdin Decembre 1990 c c======================================================================= c----------------------------------------------------------------------- c declarations: character*100 file #include "dimensions.h" INTEGER imx,ijlmx,headgrads parameter (ijlmx=(iim+1)*(jjm+1)*(llm+1)) parameter (imx=1000000) REAL x (imx),var(iim+1,jjm+1,llm) character*100 variable integer ivar integer nlong save nlong character texte*100,str4*4 INTEGER ierr,irec INTEGER i,j,l,iip1,jjp1,lnblnk,longueur INTEGER unit,it,getnd,ix integer nvarmx,nvar parameter (nvarmx=100) integer reclength,nlev,rec,nrectot character*40 varname common/gradsr/rec(nvarmx),varname(nvarmx),nlev(nvarmx) s ,reclength,nrectot,nvar character filedat*100 logical firstcall save firstcall data firstcall/.true./ c chaines de caratceres CHARACTER gtitre*100 iip1=iim+1 jjp1=jjm+1 c Ouverture du .ctl print*,'Grads' open(unit,file=file(1:lnblnk(file))//'.ctl',status='old', . form='formatted', iostat=headgrads) print*,'file=',file(1:lnblnk(file))//'.ctl' print*,'pour le ctl ierr=',ierr if (headgrads.ne.0) return nvar=0 do while(texte(1:4).ne.'vars'.and.texte(1:4).ne.'VARS') print*,'boucle sur la lecture du ctl' read(unit,'(a)',iostat=headgrads) texte print*,texte if (texte(1:4).eq.'DSET'.or.texte(1:4).eq.'dset') then filedat=texte(6:100) print*,'filedat',filedat endif if (texte(1:4).eq.'XDEF'.or.texte(1:4).eq.'xdef') then #ifdef CRAY read(texte,'(a4,i10)') str4,nlong #else read(texte,*) str4,nlong #endif print*,'Nombre de longitudes ',nlong c reclength=jjp1*nlong reclength=1 print*,'reclength=',reclength endif enddo #ifdef CRAY read(texte,'(a4,i10)') str4,nvar #else read(texte,*) str4,nvar #endif irec=1 do ivar=1,nvar read(unit,'(a)',iostat=ierr) texte i=1 do while(texte(i:i).ne." ") i=i+1 enddo varname(ivar)=texte(1:i-1) #ifdef CRAY read(texte(i:100),'(i10)') nlev(ivar) #else read(texte(i:100),*) nlev(ivar) #endif if(nlev(ivar).eq.0) nlev(ivar)=1 print*,'Variable ',ivar print*,varname(ivar),' l=',nlev(ivar) rec(ivar)=irec irec=irec+nlev(ivar) enddo nrectot=irec-1 do ivar=1,nvar print*,ivar,rec(ivar),nlev(ivar),varname(ivar) enddo print*,'Lecture entete OK' print*,'ATTENTION de ne pas avoir un ^ dans le .ctl' print*,'unit+1 ',unit+1 print*,'file=',filedat(1:lnblnk(filedat)) print*,'reclength ',reclength print*,'ATTENTION coucou 1' c open(unit+1,file=filedat(1:lnblnk(filedat)),status='old', c . form='unformatted',access='direct',recl=reclength*4) open(unit+1,file='temp.dat',status='old', . form='unformatted',access='direct',recl=reclength*4) print*,'ATTENTION coucou 2' return END