*=*=*=*= lectba.html =*=*=*=*
SUBROUTINE lectba(ldrs,nq,vcov,ucov,h,q,pext,phis,time) IMPLICIT NONE c======================================================================= c c Auteur: P. Le Van / L.Fairhead c ------- c c objet: c ------ c c Lecture de l'etat initial c c======================================================================= c----------------------------------------------------------------------- c Declarations: 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" #include "serre.h" #include "logic.h" c Arguments: c ---------- INTEGER nq LOGICAL ldrs REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),h(ip1jmp1,llm) REAL q(ip1jmp1,llm,nq) REAL pext(ip1jmp1),phis(ip1jmp1) REAL time(1) c Variables c INTEGER length,iq parameter (length = 100) REAL tab_cntrl(length) ! tableau des parametres du run INTEGER r4, ierr, start parameter (r4 = IDRS_BYTES_PER_WORD) INTEGER size INTEGER setname, aslun, cluvdb, getdat,cllun character*2 str2 c----------------------------------------------------------------------- c Ouverture DRS du fichier etat initial start = 80 PRINT*,'ldrs',ldrs IF(ldrs) THEN ierr = aslun(start,'start.dic', . start+1,'start.dat',IDRS_READ) ELSE PRINT*,'Ouverture binaire start' OPEN(start,file='start',status='old',form='unformatted', . iostat=ierr) ENDIF IF (ierr.ne.0) THEN WRITE(6,*)' Pb d''ouverture du fichier de demarrage (start)' WRITE(6,*)' ierr = ', ierr CALL exit(1) ENDIF c Lecture DRS du tableau des parametres du run IF(ldrs) THEN ierr = CLUVDB() ierr = SETNAME(' ','controle',' ',' ',' ') size = r4 * length ierr = GETDAT(start, tab_cntrl, size) ELSE READ(start) tab_cntrl ENDIF c im = tab_cntrl(1) jm = tab_cntrl(2) lmax = tab_cntrl(3) day_ini= tab_cntrl(4) 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) c c .............. P. Le Van ( ajout le 17/04/96 ) ............. c clon = tab_cntrl(17) clat = tab_cntrl(18) alphax = tab_cntrl(19) alphay = tab_cntrl(20) c c ..... ajout le 6/05/97 .... c IF ( tab_cntrl(21).EQ.0. ) THEN fxyhypb = . TRUE . ELSE fxyhypb = . FALSE . ENDIF c ................................................................. c PRINT* PRINT*,'im,jm,lmax',im,jm,lmax PRINT* PRINT*,'day_ini',day_ini PRINT* PRINT*,'rad',rad PRINT*,'omeg',omeg PRINT*,'g',g PRINT*,'mugaz',mugaz PRINT*,'kappa',kappa PRINT* PRINT*,'daysec',daysec PRINT*,'dtvr',dtvr PRINT* 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(start,rlonu, size) ierr = CLUVDB() ierr = SETNAME(' ','rlatu',' ',' ',' ') size = jjp1 * r4 ierr = GETDAT(start,rlatu, size) ierr = CLUVDB() ierr = SETNAME(' ','rlonv',' ',' ',' ') size = iip1 * r4 ierr = GETDAT(start,rlonv, size) ierr = CLUVDB() ierr = SETNAME(' ','rlatv',' ',' ',' ') size = jjm * r4 ierr = GETDAT(start,rlatv, size) c Lecture DRS des niveaux verticaux ierr = CLUVDB() ierr = SETNAME(' ','sig',' ',' ',' ') size = (llm+1) * r4 ierr = GETDAT(start,sig, size) ierr = CLUVDB() ierr = SETNAME(' ','s',' ',' ',' ') size = llm * r4 ierr = GETDAT(start,s, size) ierr = CLUVDB() ierr = SETNAME(' ','sig_s',' ',' ',' ') size = llm * r4 ierr = GETDAT(start,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(start,cu, size) ierr = CLUVDB() ierr = SETNAME(' ','cv',' ',' ',' ') size = iip1 * jjm * r4 ierr = GETDAT(start,cv, size) ierr = CLUVDB() ierr = SETNAME(' ','aire',' ',' ',' ') size = iip1 * jjp1 * r4 ierr = GETDAT(start,aire, size) c Lecture DRS geopotentiel au sol ierr = CLUVDB() ierr = SETNAME(' ','phisinit',' ',' ',' ') size = iip1 * jjp1 * r4 ierr = GETDAT(start,phis, size) ELSE READ(start) rlonu,rlatu,rlonv,rlatv,sig,s,sig_s,cu,cv,aire READ(start) phis ENDIF c Lecture DRS des champs dynamiques IF(ldrs) THEN ierr = CLUVDB() ierr = SETNAME(' ','temps',' ',' ',' ') size = 1 * r4 ierr = GETDAT(start,time, size) ierr = CLUVDB() ierr = SETNAME(' ','ucov',' ',' ',' ') size = iip1 * jjp1 * llm * r4 ierr = GETDAT(start,ucov, size) ierr = CLUVDB() ierr = SETNAME(' ','vcov',' ',' ',' ') size = iip1 * jjm * llm * r4 ierr = GETDAT(start,vcov, size) ierr = CLUVDB() size = iip1 * jjp1 * llm * r4 ierr = SETNAME(' ','h',' ',' ',' ') ierr = GETDAT(start,h, size) IF(nq.GE.1) THEN DO iq=1,nq str2(1:1)='q' WRITE(str2(2:2),'(i1.1)') iq ierr = SETNAME(' ',str2,' ',' ',' ') ierr = GETDAT(start,q(1,1,iq), size) ENDDO ENDIF ierr = CLUVDB() ierr = SETNAME(' ','pext',' ',' ',' ') size = iip1 * jjp1 * r4 ierr = GETDAT(start,pext, size) ierr = CLUVDB() ierr = SETNAME(' ','phis',' ',' ',' ') size = iip1 * jjp1 * r4 ierr = GETDAT(start,phis, size) ierr = cllun(start) ELSE IF(nq.GT.1) THEN READ(start) time,ucov,vcov,h,q,pext,phis ELSE READ(start) time,ucov,vcov,h,pext,phis ENDIF CLOSE(start) ENDIF day_ini=day_ini+INT(time(1)) time(1)=time(1)-INT(time(1)) 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 END