*=*=*=*= dataread.html =*=*=*=*
SUBROUTINE dataread(fieldname,pfield) c======================================================================= c c Author: F. Hourdin c ------- c c Object: To read data from Martian surface to use in a GCM c ------- c c Interface: c ---------- c inputs: c klong longitude number c klat latitude number c plong longitude c plat latitude c fieldname (character*80) (in fact name of the file) c c outputs: c pfield field c c======================================================================= IMPLICIT NONE c----------------------------------------------------------------------- c Declarations: c ------------- #include "dimensions.h" #include "comcstfi.h" #include "serre.h" #include "paramet.h" INTEGER klong,klat,iimp1 PARAMETER (klong=iim,klat=jjm,iimp1=iim+1-1/iim) c Arguments: c ---------- REAL pfield(iimp1,jjm+1) CHARACTER*80 fieldname c local: c ------ INTEGER klatdat,klongdat,ilatdat,ilongdat INTEGER ilat,ilong,ilong0 INTEGER icount PARAMETER (klatdat=180,klongdat=360) REAL zdata(klongdat,klatdat) REAL zlongdat(klongdat),zlatdat(klatdat) REAL zlong(klong),zlat(klat) REAL zw(iim,jjm+1),zz REAL SSUM INTEGER lnblnk EXTERNAL SSUM,lnblnk #include "lmdstd.h" CHARACTER*40 dir #include "fxyprim.h" c----------------------------------------------------------------------- c data: c ----- pi=2.*ASIN(1.) gfichier=fieldname(1:lnblnk(fieldname)) CALL readstd(klongdat*klatdat,zdata,icount) IF(klongdat*klatdat.NE.icount) THEN PRINT*,'nb longitudes, latitudes ',klong,klat PRINT*,'nb de points des donnees ',icount STOP'plante he he!' ENDIF c WRITE(*,*) zdata c gfichier='test' c gformat='7f10.0' c CALL writestd(zdata,icount) c----------------------------------------------------------------------- c initialisations: c ---------------- DO ilongdat=1,klongdat zlongdat(ilongdat)=-180.+FLOAT(ilongdat)-.5 ENDDO DO ilatdat=1,klatdat zlatdat(ilatdat)=90.-FLOAT(ilatdat)+.5 ENDDO DO ilat=1,jjm zlat(ilat)=180./pi*fy(ilat+.5) ENDDO c PRINT*,'zlat',zlat DO ilong=1,iim zlong(ilong)=180./pi*fx(ilong+.5) ENDDO c PRINT*,'zlong',zlong DO ilat=1,jjm+1 DO ilong=1,iim zw(ilong,ilat)=0. ENDDO ENDDO DO ilat=1,jjm+1 DO ilong=1,iimp1 pfield(ilong,ilat) = 0. ENDDO ENDDO c----------------------------------------------------------------------- c coordinates transform: c ---------------------- c recherche de la longitude 0: c ---------------------------- IF(iim.GT.1) THEN IF(zlong(iim)-360..LT.zlongdat(1) s .AND.zlongdat(1).LE.zlong(1)) THEN ilong0=1 ELSE ilong0=1 DO WHILE(zlong(ilong).GE.zlongdat(1).OR. s zlongdat(1).GT.zlong(ilong+1)) ilong0=ilong0+1 IF(ilong0.GT.klong) STOP'probleme des longitudes' ENDDO ENDIF c PRINT*,'ilong0=',ilong0 ENDIF c on accumule les differents points de la maille: c ----------------------------------------------- ilat=1 DO ilatdat=1,klatdat IF(ilat.LE.jjm) THEN IF(zlatdat(ilatdat).LT.zlat(ilat)) THEN ilat=ilat+1 c PRINT*,ilat,zlatdat(ilatdat) ENDIF ENDIF IF(iim.GT.1) THEN ilong=ilong0 DO ilongdat=1,klongdat zz=zdata(ilongdat,ilatdat) IF(zlongdat(ilongdat).GT.zlong(ilong)) THEN ilong=ilong+1 ilong=MOD(ilong-1,klong)+1 ENDIF pfield(ilong,ilat)=pfield(ilong,ilat)+zz zw(ilong,ilat)=zw(ilong,ilat)+1. ENDDO ELSE zz=SSUM(ilongdat,zdata(1,ilatdat),1) pfield(1,ilat)=pfield(1,ilat)+zz zw(1,ilat)=zw(1,ilat)+FLOAT(ilongdat) ENDIF ENDDO DO ilat=1,jjm+1 DO ilong=1,iim IF(zw(ilong,ilat).EQ.0.) THEN PRINT*,ilong,ilat STOP'poids nul' ELSE pfield(ilong,ilat)=pfield(ilong,ilat)/zw(ilong,ilat) ENDIF ENDDO ENDDO c----------------------------------------------------------------------- c valeur unique aux poles: c ------------------------ IF (iim.GT.1) THEN zz=SSUM(iim,pfield,1)/FLOAT(iim) DO ilong=1,iim pfield(ilong,1)=zz ENDDO zz=SSUM(iim,pfield(1,jjm+1),1)/FLOAT(iim) DO ilong=1,iim pfield(ilong,jjm+1)=zz ENDDO c----------------------------------------------------------------------- c periodicite en longitudes: c -------------------------- DO ilat=1,jjm+1 pfield(iimp1,ilat)=pfield(1,ilat) ENDDO c CALL uniplot(iimp1,jjm+1,pfield) ENDIF c----------------------------------------------------------------------- END