*=*=*=*= readhead.html =*=*=*=*
SUBROUTINE readhead(unit,ldrs,day0,phis) c%W% %G% c======================================================================= c c Author: Frederic Hourdin original: 11/11/92 c ------- c c Subject: c ------ c How to read the headings of the history files c c Method: c -------- c c Interface: c ---------- c c Input: c ------ c c Output: c ------- c c======================================================================= IMPLICIT NONE c----------------------------------------------------------------------- c Declararations: c --------------- #include "dimensions.h" #include "paramet.h" #include "temps.h" #include "comconst.h" #include "comvert.h" #include "comgeom.h" #include "ener.h" #include "drsdef.h" #include "description.h" c Arguments: c ---------- INTEGER*4 day0 INTEGER readunit,typfile REAL phis(ip1jmp1) LOGICAL ldrs c Local: c ------ c----------------------------------------------------------------------- c READ(readunit) im,jm,lmax,day0, c s rad,omeg,g,mugaz,kappa, c s daysec,dtvr, c s phis, c s etot0,ptot0,ztot0,stot0,ang0, c s sig,s, c s rlonu,rlonv,rlatu,rlatv, c s cu,cv,aire c PRINT*, c s 'im,jm,lmax', c s im,jm,lmax, c s 'dtvr,sig,s,rlonu,rlonv,rlatu,rlatv,phis', c s dtvr,sig,s,rlonu,rlonv,rlatu,rlatv,phis, c s 'cu,cv,aire,cpp,r,g', c s cu,cv,aire,cpp,r,g c Variables c INTEGER length,iq parameter (length = 100) REAL tab_cntrl(length) ! tableau des parametres du run INTEGER r4, ierr, unit parameter (r4 = IDRS_BYTES_PER_WORD) INTEGER size INTEGER setname, aslun, cluvdb, getdat,cllun character*2 str2 c----------------------------------------------------------------------- c Lecture DRS du tableau des parametres du run IF(ldrs) THEN ierr = CLUVDB() ierr = SETNAME(' ','controle',' ',' ',' ') size = r4 * length ierr = GETDAT(unit, tab_cntrl, size) ELSE READ(unit) tab_cntrl ENDIF im = tab_cntrl(1) jm = tab_cntrl(2) lmax = tab_cntrl(3) day_ini = tab_cntrl(4) day0 = day_ini rad = tab_cntrl(5) omeg = tab_cntrl(6) g = tab_cntrl(7) mugaz = tab_cntrl(8) kappa = tab_cntrl(9) daysec = tab_cntrl(10) dtvr = tab_cntrl(11) etot0 = tab_cntrl(12) ptot0 = tab_cntrl(13) ztot0 = tab_cntrl(14) stot0 = tab_cntrl(15) ang0 = tab_cntrl(16) PRINT*,'im,jm,lmax,day_ini',im,jm,lmax,day_ini PRINT*,'rad,omeg,g,mugaz,kappa', s rad,omeg,g,mugaz,kappa PRINT*,'daysec,dtvr',daysec,dtvr IF( im.ne.iim ) THEN PRINT 1,im,iim STOP ELSE IF( jm.ne.jjm ) THEN PRINT 2,jm,jjm STOP ELSE IF( lmax.ne.llm ) THEN PRINT 3,lmax,llm STOP ENDIF IF(ldrs) THEN c Lecture DRS des longitudes et latitudes ierr = CLUVDB() ierr = SETNAME(' ','rlonu',' ',' ',' ') size = iip1 * r4 ierr = GETDAT(unit,rlonu, size) ierr = CLUVDB() ierr = SETNAME(' ','rlatu',' ',' ',' ') size = jjp1 * r4 ierr = GETDAT(unit,rlatu, size) ierr = CLUVDB() ierr = SETNAME(' ','rlonv',' ',' ',' ') size = iip1 * r4 ierr = GETDAT(unit,rlonv, size) ierr = CLUVDB() ierr = SETNAME(' ','rlatv',' ',' ',' ') size = jjm * r4 ierr = GETDAT(unit,rlatv, size) c Lecture DRS des niveaux verticaux ierr = CLUVDB() ierr = SETNAME(' ','sig',' ',' ',' ') size = (llm+1) * r4 ierr = GETDAT(unit,sig, size) ierr = CLUVDB() ierr = SETNAME(' ','s',' ',' ',' ') size = llm * r4 ierr = GETDAT(unit,s, size) ierr = CLUVDB() ierr = SETNAME(' ','sig_s',' ',' ',' ') size = llm * r4 ierr = GETDAT(unit,sig_s, size) c Lecture DRS aire et coefficients de passage cov. <-> contra. <--> naturel ierr = CLUVDB() ierr = SETNAME(' ','cu',' ',' ',' ') size = iip1 * jjp1 * r4 ierr = GETDAT(unit,cu, size) ierr = CLUVDB() ierr = SETNAME(' ','cv',' ',' ',' ') size = iip1 * jjm * r4 ierr = GETDAT(unit,cv, size) ierr = CLUVDB() ierr = SETNAME(' ','aire',' ',' ',' ') size = iip1 * jjp1 * r4 ierr = GETDAT(unit,aire, size) c Lecture DRS geopotentiel au sol ierr = CLUVDB() ierr = SETNAME(' ','phisinit',' ',' ',' ') size = iip1 * jjp1 * r4 ierr = GETDAT(unit,phis, size) ELSE READ(unit) rlonu,rlatu,rlonv,rlatv,sig,s,sig_s,cu,cv,aire READ(unit) phis ENDIF 1 FORMAT(//10x'la valeur de im =',i4,2x,'lue sur le fichier de dema *rrage est differente de la valeur parametree iim ='i4//) 2 FORMAT(//10x'la valeur de jm =',i4,2x,'lue sur le fichier de dema *rrage est differente de la valeur parametree jjm ='i4//) 3 FORMAT(//10x'la valeur de lmax =',i4,2x,'lue sur le fichier demar *rage est differente de la valeur parametree llm ='i4//) 4 FORMAT(//10x'la valeur de dtrv =',i4,2x,'lue sur le fichier demar *rage est differente de la valeur dtinteg ='i4//) RETURN c999 STOP'probleme dans la lecture de l entete' END