*=*=*=*= readfi.html =*=*=*=*
SUBROUTINE readfi(fichier,tab0,Lmodif,ngrid,nsoil,ldrs, . day_ini,time,co2ice,tsurf,tsoil,emis,q2) IMPLICIT NONE c======================================================================= c c Auteur: P. Le Van / F Hourdin / F Forget c ------- c c objet: c ------ c c Lecture de l'etat initial physique c c======================================================================= c----------------------------------------------------------------------- c Declarations: c ------------- #include "dimensions.h" #include "dimphys.h" #include "comcstfi.h" #include "comgeomfi.h" #include "drscoorfi.h" #include "planete.h" #include "surfdat.h" #include "drsdef.h" #include "dimradmars.h" #include "yomaer.h" c Arguments: c ---------- CHARACTER*80 fichier integer tab0 integer Lmodif INTEGER lnblnk EXTERNAL lnblnk INTEGER ngrid,nsoil integer*4 day_ini LOGICAL ldrs REAL co2ice(ngrid),tsurf(ngrid),tsoil(ngrid,nsoil),emis(ngrid) REAL q2(ngrid, nlayermx+1) REAL time c Variables c integer length 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 integer lmax , ig , icap,lg,isamax REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec c----------------------------------------------------------------------- c Ouverture DRS du fichier etat initial unit = 94 c write (*,*) 'ldrs = ' , ldrs c IF(ldrs) THEN c ierr = aslun(start,'startfi.dic', c . start+1,'startfi.dat',IDRS_READ) c ELSE c PRINT*,'Lecture du fichier initial binaire physique' c OPEN(start,file='startfi',form='unformatted',status='old', c . iostat=ierr) c ENDIF c if (ierr.ne.0) then c write(6,*)' Pb d''ouverture du fichier startfi. Est-il la ?' c write(6,*)' ierr = ', ierr c call exit(1) c endif c Modifs pour pouvoir tourner plus facilement avec des fichiers c de demarrage DRS ou non OPEN(unit,file=fichier(1:lnblnk(fichier)),status='old', . form='unformatted', . iostat=ierr) ldrs=ierr.ne.0 if(ldrs) THEN close(unit) ierr = aslun(unit,fichier(1:lnblnk(fichier))//'.dic', . unit+1,fichier(1:lnblnk(fichier))//'.dat',IDRS_READ) else print*,'WARNING!!! on part d''un fichier non DRS' endif IF (ierr.ne.0) THEN WRITE(6,*)' Pb d ouverture du fichier de demarrage (unit)' WRITE(6,*)' ierr = ', ierr CALL exit(1) ENDIF c----------------------------------------------------------------------- c Lecture du tab_cntrl et initialisation des constantes physiques c----------------------------------------------------------------------- PRINT* write(*,*) 'TABFI de readfi' call tabfi (unit,Lmodif,tab0,ldrs,day_ini,lmax,p_rad, . p_omeg,p_g,p_mugaz,p_daysec) c----------------------------------------------------------------------- if(ldrs) then c Lecture DRS des longitudes et latitudes ierr = CLUVDB() ierr = SETNAME(' ','hor_coor',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,hor_coor, size) ierr = CLUVDB() ierr = SETNAME(' ','vert_coor',' ',' ',' ') size = nlayermx * r4 ierr = GETDAT(unit,vert_coor, size) ierr = CLUVDB() ierr = SETNAME(' ','vert2_coor',' ',' ',' ') size = (nlayermx+1) * r4 ierr = GETDAT(unit,vert2_coor, size) ierr = CLUVDB() ierr = SETNAME(' ','long',' ',' ',' ') size = ngridmx * r4 ierr = GETDAt(unit,long, size) ierr = CLUVDB() ierr = SETNAME(' ','lati',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,lati, size) ierr = CLUVDB() ierr = SETNAME(' ','area',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,area, size) ierr = CLUVDB() ierr = SETNAME(' ','phisfi',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,phisfi, size) ierr = CLUVDB() ierr = SETNAME(' ','albedodat',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,albedodat, size) ierr = CLUVDB() ierr = SETNAME(' ','inertiedat',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,inertiedat, size) c!-*- c ierr = CLUVDB() ierr = SETNAME(' ','zmea',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,zmea, size) print*,'MAX de ZMEA',zmea(isamax(ngridmx,zmea,1)) c ierr = CLUVDB() ierr = SETNAME(' ','zstd',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,zstd, size) c ierr = CLUVDB() ierr = SETNAME(' ','zsig',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,zsig, size) c ierr = CLUVDB() ierr = SETNAME(' ','zgam',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,zgam, size) c ierr = CLUVDB() ierr = SETNAME(' ','zthe',' ',' ',' ') size = ngridmx * r4 ierr = GETDAT(unit,zthe, size) c c!-*- else read(unit) long,lati,area,phisfi read(unit) albedodat,inertiedat read(unit) zmea,zstd,zsig,zgam,zthe endif PRINT* PRINT*,'ngrid,lmax',ngrid,lmax PRINT*,'rad',rad PRINT*,'omeg',omeg PRINT*,'g',g PRINT*,'mugaz',mugaz PRINT*,'rcp',rcp PRINT* PRINT*,'daysec',daysec PRINT*,'dtphys',dtphys PRINT* IF( ngrid.ne.ngridmx ) THEN PRINT 1,ngrid,ngridmx STOP ELSE IF( lmax.ne.nlayermx ) THEN PRINT 2,lmax,nlayermx STOP ENDIF IF(ldrs) THEN ierr = CLUVDB() ierr = SETNAME(' ','temps',' ',' ',' ') size = 1 * r4 ierr = GETDAT(unit,time, size) ierr = CLUVDB() ierr = SETNAME(' ','co2ice',' ',' ',' ') size = ngridmx*r4 ierr = GETDAT(unit,co2ice, size) ierr = CLUVDB() ierr = SETNAME(' ','tsurf',' ',' ',' ') size = ngridmx*r4 ierr = GETDAT(unit,tsurf, size) ierr = CLUVDB() ierr = SETNAME(' ','tsoil',' ',' ',' ') size = ngridmx*nsoil * r4 ierr = GETDAT(unit,tsoil, size) ierr = CLUVDB() ierr = SETNAME(' ','emis',' ',' ',' ') size = ngridmx*r4 ierr = GETDAT(unit,emis, size) c ----------------------------------------------- c Case when using a start file from before March 1996 (without emis) if (ierr.ne.0) then write (*,*) ' WARNING : emis not in . this initialisation file' write (*,*) ' emis set to emissiv / emisice' do ig =1,ngrid IF(ig.GT.ngrid/2+1) THEN icap=2 ELSE icap=1 ENDIF emis(ig) = emissiv if (co2ice(ig).gt.0) emis(ig) = emisice(icap) end do end if c ----------------------------------------------- ierr = CLUVDB() ierr = SETNAME(' ','q2',' ',' ',' ') size = ngridmx*(nlayermx+1)* r4 ierr = GETDAT(unit,q2, size) c ----------------------------------------------- c Case when using a start file from before March 1996 (without q2) if (ierr.ne.0) then write (*,*) ' WARNING : q2 not in this initialisation file' write (*,*) ' q2 set to 0' do lg = 1, nlayermx+1 do ig =1,ngrid q2(ig,lg) = 0. end do end do end if c ----------------------------------------------- ierr =cllun(unit) ELSE READ(unit) time READ(unit) co2ice,tsurf,tsoil,emis,q2 CLOSE(unit) ENDIF c reindexation de day_ini si le parametre temps de l'etat lu >= 1 day_ini=day_ini+INT(time) 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//) RETURN END