c############################################################################## c Sample.f: beta version written by H. Yoshinari and N. Maximenko c (2005/12/16) c Corrected by K. Lebedev c (2009/06/08) c############################################################################## implicit real(a-h,o-z) implicit integer(i-n) parameter(max1=1000000) parameter(nfloat=100000,nDAC=10,ntype=10) real Xndp(max1),Yndp(max1),Zpk(max1),Tndp(max1),Undp(max1), & Vndp(max1),EUndp(max1),EVndp(max1),Xnsf(max1),Ynsf(max1), & Tnsf(max1),Unsf(max1),Vnsf(max1),EUnsf(max1),EVnsf(max1), & Xmlt(max1),Ymlt(max1),Tmlt(max1),Xnft(max1),Ynft(max1), & Tnft(max1),Xnlt(max1),Ynlt(max1),Tnlt(max1) integer Nnfx(max1),ID(max1),Cyc(max1),Flg(max1) integer WMOID(nfloat),DAC(nfloat),type(nfloat) character nmDAC(nDAC)*17,nmtype(ntype)*9 character chk*1 real*8 abst00 call ABSTM(abst00,2000,1,1,0,0) c--- Open the file: "yomaha07.dat". ------------------------------------------- open(99,file='yomaha07.dat') c--- Read the values stored in "yomaha07.dat". -------------------------------- c ------------------------------ i=1 c---format of yomaha07.dat 199 format(f9.4,f9.4,f7.1,f9.3,4f8.2,f10.4,f9.4,f9.3,4f8.2, ,3(f10.4,f9.4,f9.3),2i5,i4,i2) c ------------------------------ 1 read(99,199,end=49) Xndp(i),Yndp(i),Zpk(i),Tndp(i),Undp(i), & Vndp(i),EUndp(i),EVndp(i),Xnsf(i),Ynsf(i),Tnsf(i),Unsf(i), & Vnsf(i),EUnsf(i),EVnsf(i),Xmlt(i),Ymlt(i),Tmlt(i),Xnft(i), & Ynft(i),Tnft(i),Xnlt(i),Ynlt(i),Tnlt(i),Nnfx(i),ID(i), & Cyc(i),Flg(i) if(i.gt.max1) write(*,*) ' **ERROR** - max dimension exceeded !!!' if(i.gt.max1) STOP i=i+1 go to 1 c ------------------------------ 49 ntd = i-1 close(99) c--- Open the file: "WMO2DAC2type.txt". ----------------------------------------- open(98,file='WMO2DAC2type.txt') c--- Read the values stored in "WMO2DAC2type.txt". ------------------------------ c ------------------------------ 2 read(98,198,end=3) i,WMOID(i),DAC(i),type(i) 198 format(i6,i8,2i2) go to 2 c ------------------------------ 3 close(98) c--- Open the file: "DACs.txt". ----------------------------------------------- open(97,file='DACs.txt') c--- Read the values stored in "DACs.txt". ------------------------------------ c ------------------------------ 4 read(97,'(i3,3x,a17)',end=5) i,nmDAC(i) go to 4 c ------------------------------ 5 close(97) c--- Open the file: "float_types.txt". ---------------------------------------- open(96,file='float_types.txt') c--- Read the values stored in "float_types.txt". ----------------------------- c ------------------------------ 6 read(96,'(i6,3x,a9)',end=7,err=7) i,nmtype(i+1) go to 6 c ------------------------------ 7 close(96) write(*,*) 'There are ',ntd,' velocity records in "yomaha07.dat".' 48 continue write(*,*) 'Enter the data # you want to see: (1-',ntd,')' read(*,*) nd if(nd.gt.ntd.or.nd.lt.1) write(*,*) 'Wrong data #',nd if(nd.gt.ntd.or.nd.lt.1) go to 48 write(*,*) '____________________________________________________', &'_________________' write(*,*) ' Record number:............ ',nd write(*,*) ' Serial Float ID:.......... ',ID(nd) write(*,*) ' Cycle Number:............. ',Cyc(nd) write(*,*) ' WMO float ID:............. ',WMOID(ID(ND)) write(*,*) ' DAC:...................... ', &nmDAC(DAC(ID(ND))) write(*,*) ' Float Type:............... ', &nmtype(type(ID(ND))+1) write(*,*) 'Longitude of deep velocity (DV) estimate:', &'..................',Xndp(nd) write(*,*) 'Latitude of DV estimate:............', &'.......................',Yndp(nd) write(*,*) 'Programed parking pressure [dbar]:..', &'.......................',Zpk(nd) write(*,*) 'Julian day (JD) of DV estimate since', &' 2000-01-01 00:00:00 : ',Tndp(nd) call CDATE(NYEAR,NMONTH,NDAY,NHOUR,NMINUT,SEC,ABST00 & +Tndp(nd)*1440.) write(*,'(a,i10,a1,i2.2,a1,i2.2,i3.2,a1,i2.2,a1,i2.2)') & ' Calendar date of DV estimate:', & NYEAR,'-',NMONTH,'-',NDAY,NHOUR,':',NMINUT,':',nint(SEC) write(*,*) 'Zonal component of DV [cm/s]:.......', &'.......................',Undp(nd) write(*,*) 'Meridional component of DV [cm/s]:..', &'.......................',Vndp(nd) write(*,*) 'Error of zonal component of DV [cm/s]:', &'.....................',EUndp(nd) write(*,*) 'Error of meridional component of DV [cm/s]:', &'................',EVndp(nd) write(*,*) ' Longitude of surface velocity (SV) estimate:.', &'...',Xnsf(nd) write(*,*) ' Latitude of SV estimate:.....................', &'...',Ynsf(nd) write(*,*) ' JD of SV estimate since 2000-01-01 00:00:00 :', &'...',Tnsf(nd) write(*,*) ' Zonal component of SV [cm/s]:................', &'...',Unsf(nd) write(*,*) ' Meridional component of SV [cm/s]:...........', &'...',Vnsf(nd) write(*,*) ' Error of zonal component of SV [cm/s]:.......', &'...',EUnsf(nd) write(*,*) ' Error of meridional component of DV [cm/s]:..', &'...',EVnsf(nd) write(*,*) 'Longitude of last fix of previous cycle:.........', &'........... ',Xmlt(nd) write(*,*) 'Latitude of last fix of previous cycle:..........', &'........... ',Ymlt(nd) write(*,*) 'JD of last fix of previous cycle since 2000-01-01', &' 00:00:00 : ',Tmlt(nd) write(*,*) ' Longitude of first fix of this cycle:.........', &'........... ',Xnft(nd) write(*,*) ' Latitude of first fix of this cycle:..........', &'........... ',Ynft(nd) write(*,*) ' JD of first fix of this cycle since 2000-01-01', &' 00:00:00 : ',Tnft(nd) write(*,*) 'Longitude of last fix of this cycle:.........', &'............',Xnlt(nd) write(*,*) 'Latitude of last fix of this cycle:..........', &'............',Ynlt(nd) write(*,*) 'JD of last fix of this cycle since 2000-01-01', &' 00:00:00 : ',Tnlt(nd) write(*,*) &'Number of fixes at the sea surface in this cycle:....', &Nnfx(nd) write(*,*) 'Time flag: ',Flg(nd) write(*,*) '____________________________________________________', &'_________________' c ------------------------------ write(*,*) 'Do you want to see the another records? [y/n]' read(*,'(a1)') chk c ++++++++++++++++++++++++++++++ if (chk .eq. 'y') then go to 48 end if c ++++++++++++++++++++++++++++++ write(*,*) 'Thanks for using YoMaHa07 dataset. Bye!' c stop end C C********************************************************************* SUBROUTINE CDATE(NYEAR,NMONTH,NDAY,NHOUR,NMINUT,SEC,ABST) C********************************************************************* DOUBLE PRECISION ABST, ABST1, MINYR4, MINYR, MINMON(13), & MINDAY, MINMN(13) DATA MINYR4, MINYR, MINDAY/210384D+01,5256D+02,144D+01/ DATA MINMN/0D+00,4464D+01,8496D+01,1296D+02, & 1728D+02,21744D+01,26064D+01,30528D+01,34992D+01, & 39312D+01,43776D+01,48096D+01,5256D+02/ ABST1 = ABST DO 1 I = 1, 13 1 MINMON(I) = MINMN(I) NYEAR = ABST1/MINYR4 + 1.D-08 ABST1 = ABST1 - NYEAR*MINYR4 NY = ABST1/MINYR + 1.D-07 NYEAR = 4*NYEAR + NY + 1 ABST1 = ABST1 - NY*MINYR DO 2 I = 2, 13 NMONTH = I - 1 IF(MOD(NYEAR,4).EQ.0.AND.I.GT.2) MINMON(I)=MINMON(I)+MINDAY IF(ABST1.LT.MINMON(I)) GO TO 3 2 CONTINUE WRITE (*,100) 100 FORMAT (' ERROR! ') STOP 3 ABST1 = ABST1 - MINMON(NMONTH) NDAY = ABST1/MINDAY + 1.D-05 ABST1 = ABST1 - NDAY*MINDAY NDAY = NDAY + 1 C NHOUR = ABST1/60 + 0.001 C NMINUT = ABST1 - NHOUR*60 + 0.1 NHOUR = ABST1/60 NMINUT = ABST1 - NHOUR*60 SEC = (ABST1 - NHOUR*60-NMINUT)*60. RETURN END C C*********************************************************************** SUBROUTINE ABSTM(ABST,NYEAR,NMONTH,NDAY,NHOUR,NMINUT) C*********************************************************************** DOUBLE PRECISION ABST, MINYR, MINMON(12), MINDAY DATA MINYR, MINDAY/5256D+02,144D+01/ DATA MINMON/0D+00,4464D+01,8496D+01,1296D+02, & 1728D+02,21744D+01,26064D+01,30528D+01,34992D+01, & 39312D+01,43776D+01,48096D+01/ IF(NMONTH.LT.1.OR.NMONTH.GT.12) GO TO 1 IF(NDAY.GT.31) GO TO 1 IF(NHOUR.LT.0.OR.NHOUR.GT.23) GO TO 1 IF(NMINUT.LT.0.OR.NMINUT.GT.59) GO TO 1 IF((NMONTH.EQ.4.OR.NMONTH.EQ.6.OR.NMONTH.EQ.9.OR. & NMONTH.EQ.11).AND.NDAY.GT.30) GO TO 1 IF(MOD(NYEAR,4).NE.0.AND.NMONTH.EQ.2.AND.NDAY.GT.28) & GO TO 1 IF(NMONTH.EQ.2.AND.NDAY.GT.29) GO TO 1 NY = NYEAR - 1 C ABST = NY*MINYR + ((NY/4)+NDAY-1)*MINDAY + MINMON(NMONTH) + C & NHOUR*60 + NMINUT + 0.1 ABST = NY*MINYR + ((NY/4)+NDAY-1)*MINDAY + MINMON(NMONTH) + & NHOUR*60 + NMINUT IF(MOD(NYEAR,4).EQ.0.AND.NMONTH.GT.2) ABST = ABST + MINDAY RETURN 1 WRITE (*,100) 100 FORMAT (' ERROR IN DATE! ') STOP END c