!--------------------------------------------------------------------- Subroutine Write_GrADS_Stn_Multivar_1 (X,Grads_File,iidx) ! (Nst,NLen,ndr_idx) Integer :: imon, ivar, ist, ic, i, iidx Character (Len=8) :: STID Character *(*) :: Grads_File Real :: X(Nst,Nidx,Nlen,ndr_idx) !Nst,Nmon,NLen,ndr_idx) ! (Nst,2,Nvar) Real :: RLAT, RLON, TIM, tmp, Var Integer :: NLEV,NFLAG !---------------------------------------------------------------------------------- Open (10,file=trim(Grads_File)//'.dat',FORM='UNFORMATTED',RECORDTYPE='STREAM') TIM = 0.0 ! Co the bien doi tu -0.5 .. +0.5; thuong dat bang 0. NFLAG = 1 ! Khong doi Do i = 1,Nlen ! Nvar chi so, moi chi so duoc xem nhu 1 timeslice NLEV = 1 ! =0 o ban ghi cuoi cung cua 1 timeslice; =1 cho tat ca cac timeslice khac ic = 0 Do ist=1, Nst ic = ic+1 STID = Stname(ist)(1:8) ! Chi lay 8 ky tu dau tien RLAT = xlat(ist); RLON = xlon(ist) WRITE (10) STID,RLAT,RLON,TIM,NLEV,NFLAG Do imon=1,Nidx Var = X(ist,imon,i,iidx) WRITE (10) Var ! Gia tri cua bien Enddo Enddo NLEV = 0 WRITE (10) STID,RLAT,RLON,TIM,NLEV,NFLAG Enddo ! ivar Close(10) !---------------------------------------------------------------------! ! Write control file Station data ! !---------------------------------------------------------------------! open (2001,file=trim(Grads_File)//'.ctl') write (2001,'(2A)') 'dset ','^'//trim(Grads_File)//'.dat' write (2001,'(A)') 'dtype station' write (2001,'(2A)') 'stnmap ','^'//trim(Grads_File)//'.dat'//'.map' write (2001,'(A,F8.1)') 'undef ',Miss write (2001,'(A)') 'title Factor Analysis' write (2001,'(A,I3,1x,A)') 'tdef ',Nlen,' linear jan1980 1mo' write (2001,'(A,I3)') 'vars ',Nidx Do imon=1,Nidx write (2001,'(A,I2.2,A)') trim(IDX_nm(iidx)),imon,' 0 99 Drough Chars' Enddo write (2001,'(A)') 'endvars' close (2001) End Subroutine Write_GrADS_Stn_Multivar_1 !--------------------------------------------------------------------- Subroutine Write_GrADS_Stn_Multivar_2 (X,Grads_File,iidx) ! (Nst,NLen,ndr_idx) Integer :: imon, ivar, ist, ic, i, iidx Character (Len=8) :: STID Character *(*) :: Grads_File Real :: X(Nst,Nmode,Nlen,ndr_idx) !Nst,Nmon,NLen,ndr_idx) ! (Nst,2,Nvar) Real :: RLAT, RLON, TIM, tmp, Var Integer :: NLEV,NFLAG !---------------------------------------------------------------------------------- Open (10,file=trim(Grads_File)//'.dat',FORM='UNFORMATTED',RECORDTYPE='STREAM') TIM = 0.0 ! Co the bien doi tu -0.5 .. +0.5; thuong dat bang 0. NFLAG = 1 ! Khong doi Do i = 1,Nlen ! Nvar chi so, moi chi so duoc xem nhu 1 timeslice NLEV = 1 ! =0 o ban ghi cuoi cung cua 1 timeslice; =1 cho tat ca cac timeslice khac ic = 0 Do ist=1, Nst ic = ic+1 STID = Stname(ist)(1:8) ! Chi lay 8 ky tu dau tien RLAT = xlat(ist); RLON = xlon(ist) WRITE (10) STID,RLAT,RLON,TIM,NLEV,NFLAG Do imon=1,Nmode Var = X(ist,imon,i,iidx) WRITE (10) Var ! Gia tri cua bien Enddo Enddo NLEV = 0 WRITE (10) STID,RLAT,RLON,TIM,NLEV,NFLAG Enddo ! ivar Close(10) !---------------------------------------------------------------------! ! Write control file Station data ! !---------------------------------------------------------------------! open (2001,file=trim(Grads_File)//'.ctl') write (2001,'(2A)') 'dset ','^'//trim(Grads_File)//'.dat' write (2001,'(A)') 'dtype station' write (2001,'(2A)') 'stnmap ','^'//trim(Grads_File)//'.dat'//'.map' write (2001,'(A,F8.1)') 'undef ',Miss write (2001,'(A)') 'title Factor Analysis' write (2001,'(A,I3,1x,A)') 'tdef ',Nlen,' linear jan1980 1mo' write (2001,'(A,I3)') 'vars ',Nmode Do imon=1,Nmode write (2001,'(A,I2.2,A)') trim(IDX_nm(iidx)),imon,' 0 99 Drough Chars' Enddo write (2001,'(A)') 'endvars' close (2001) End Subroutine Write_GrADS_Stn_Multivar_2 !--------------------------------------------------------------------- Subroutine Write_GrADS_Stn_Multivar (X,Grads_File,iidx) ! (Nst,NLen,ndr_idx) Integer :: imon, ivar, ist, ic, Nidx, i, iidx Character (Len=8) :: STID Character *(*) :: Grads_File Real :: X(Nst,Nmon,NLen,ndr_idx) ! (Nst,2,Nvar) Real :: RLAT, RLON, TIM, tmp, Var Integer :: NLEV,NFLAG !---------------------------------------------------------------------------------- Open (10,file=trim(Grads_File)//'.dat',FORM='UNFORMATTED',RECORDTYPE='STREAM') TIM = 0.0 ! Co the bien doi tu -0.5 .. +0.5; thuong dat bang 0. NFLAG = 1 ! Khong doi Do i = 1,Nlen ! Nvar chi so, moi chi so duoc xem nhu 1 timeslice NLEV = 1 ! =0 o ban ghi cuoi cung cua 1 timeslice; =1 cho tat ca cac timeslice khac ic = 0 Do ist=1, Nst ic = ic+1 STID = Stname(ist)(1:8) ! Chi lay 8 ky tu dau tien RLAT = xlat(ist); RLON = xlon(ist) WRITE (10) STID,RLAT,RLON,TIM,NLEV,NFLAG Do imon=1,Nmon Var = X(ist,imon,i,iidx) WRITE (10) Var ! Gia tri cua bien Enddo Enddo NLEV = 0 WRITE (10) STID,RLAT,RLON,TIM,NLEV,NFLAG Enddo ! ivar Close(10) !---------------------------------------------------------------------! ! Write control file Station data ! !---------------------------------------------------------------------! open (2001,file=trim(Grads_File)//'.ctl') write (2001,'(2A)') 'dset ','^'//trim(Grads_File)//'.dat' write (2001,'(A)') 'dtype station' write (2001,'(2A)') 'stnmap ','^'//trim(Grads_File)//'.dat'//'.map' write (2001,'(A,F8.1)') 'undef ',Miss write (2001,'(A)') 'title Factor Analysis' write (2001,'(A,I3,1x,A)') 'tdef ',Nlen,' linear jan1980 1mo' write (2001,'(A,I3)') 'vars ',Nmon Do imon=1,Nmon write (2001,'(A,I2.2,A)') trim(IDX_nm(iidx)),imon,' 0 99 Drough Chars' Enddo write (2001,'(A)') 'endvars' close (2001) End Subroutine Write_GrADS_Stn_Multivar !--------------------------------------------------------------------- Subroutine Write_GrADS_Stn (X,Grads_File,iidx) ! (Nst,NLen,ndr_idx) Integer :: ivar, ist, ic, Nidx, i, iidx Character (Len=8) :: STID Character *(*) :: Grads_File !, varn !, Out_Dir, Field !Real :: X(Nst, Nidx), Lon(Nst), Lat(Nst) !Integer, Parameter :: Nvar=9 Real :: X(Nst,NLen,ndr_idx) ! (Nst,2,Nvar) Real :: RLAT, RLON, TIM, tmp, Var Integer :: NLEV,NFLAG !---------------------------------------------------------------------------------- !Allocate (X(Nst,Nvar)) !print*,"In GrADS: Nst=",Nst !Do ist=1,Nst ! X(ist,1)=HWN_Sen (ist,ivar); X(ist,2)=HWDx_Sen(ist,ivar); X(ist,3)=HWDm_Sen(ist,ivar) ! X(ist,4)=HDays_Sen(ist,ivar); X(ist,5)=HWF_Sen (ist,ivar); X(ist,6)=HWM_Sen (ist,ivar) ! X(ist,7)=HWA_Sen (ist,ivar); X(ist,8)=HWS_Sen (ist,ivar); X(ist,9)=HWSx_Sen(ist,ivar) !Enddo Open (10,file=trim(Grads_File)//'.dat',FORM='UNFORMATTED',RECORDTYPE='STREAM') TIM = 0.0 ! Co the bien doi tu -0.5 .. +0.5; thuong dat bang 0. NFLAG = 1 ! Khong doi ! STID: character(len=8) ==> Station name ! SenSL, Prob: !Do iidx=1,ndr_idx Do i = 1,Nlen ! Nvar chi so, moi chi so duoc xem nhu 1 timeslice NLEV = 1 ! =0 o ban ghi cuoi cung cua 1 timeslice; =1 cho tat ca cac timeslice khac ic = 0 Do ist=1, Nst ic = ic+1 STID = Stname(ist)(1:8) ! Chi lay 8 ky tu dau tien RLAT = xlat(ist); RLON = xlon(ist) WRITE (10) STID,RLAT,RLON,TIM,NLEV,NFLAG Var = X(ist,i,iidx) WRITE (10) Var ! Gia tri cua bien Enddo ! before new time: NLEV = 0 WRITE (10) STID,RLAT,RLON,TIM,NLEV,NFLAG Enddo ! ivar !Enddo Close(10) !---------------------------------------------------------------------! ! Write control file Station data ! !---------------------------------------------------------------------! open (2001,file=trim(Grads_File)//'.ctl') write (2001,'(2A)') 'dset ','^'//trim(Grads_File)//'.dat' write (2001,'(A)') 'dtype station' write (2001,'(2A)') 'stnmap ','^'//trim(Grads_File)//'.dat'//'.map' write (2001,'(A,F8.1)') 'undef ',Miss write (2001,'(A)') 'title Factor Analysis' write (2001,'(A,I3,1x,A)') 'tdef ',Nlen,' linear jan1980 1mo' ! write (2001,'(A,I3,1x,A)') 'tdef ',1,'linear jan1980 1mo' write (2001,'(A)') 'vars 1' write (2001,'(A)') trim(IDX_nm(iidx))//' 0 99 Drough Chars' !write (2001,'(A)') 'spei 0 99 '//trim(varn) write (2001,'(A)') 'endvars' close (2001) !Enddo ! ivar !Deallocate (X) End Subroutine Write_GrADS_Stn !---------------------------------------------------------------------