! ! $Author: tomita $ ! $Date: 2007/08/01 20:09:58 $ ! $Revision: 1.1.1.1 $ ! PROGRAM AOI_SSTNOAA USE InputParameters, ONLY: r4, r8,i4, & nferr, nfclm, nfout, nfctl,nfvgm, & Imax, Jmax, Idim_sst, Jdim_sst,kdim,Idim_xice, Jdim_xice,Undef, & nLats,DirPreIn, DirPreOut, DirModelIn, & VarName, VarNameOut, DirMainInput,DirMainOutputmon,DirMainOutputwkl, GrADS, Linear, & InitInputParameters,LabelI,LabelF USE time_module, ONLY: julian_day,weekday_nm use MOD_NETCDF_SST, only:sfc_sst,lat0_sst,lon0_sst,tsize_sst,xSize_sst,ySize_sst,nVarNetcdf_SST,& Init_Netcdf_Parameter_SST,& READ_Netcdf_Field_SST2,& Finalize_Netcdf_Parameter_SST use MOD_NETCDF_xice, only:sfc_xice,lat0_xice,lon0_xice,tsize_xice,xSize_xice,ySize_xice,nVarNetcdf_xice,& Init_Netcdf_Parameter_xice,& READ_Netcdf_Field_xice2,& Finalize_Netcdf_Parameter_xice ! First Point of Initial Data is near South Pole and near Greenwhich ! First Point of Output Data is near North Pole and near Greenwhich IMPLICIT NONE INTEGER :: Month, LRec, ios,k,i,j CHARACTER (LEN=12) :: TimeGrADS=' Z ' CHARACTER (LEN=3), DIMENSION(12) :: MonthChar = & (/ 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', & 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC' /) REAL (KIND=r8), DIMENSION (:,:) , ALLOCATABLE :: VarField_XICE REAL (KIND=r8), DIMENSION (:,:) , ALLOCATABLE :: VarFieldO_XICE REAL (KIND=r4), DIMENSION (:,:) , ALLOCATABLE :: XICEDump REAL (KIND=r8), DIMENSION (:,:) , ALLOCATABLE :: VarField_sst REAL (KIND=r8), DIMENSION (:,:) , ALLOCATABLE :: VarFieldO_SST REAL (KIND=r4), DIMENSION (:,:) , ALLOCATABLE :: SSTDump REAL (KIND=r8), DIMENSION (:) , ALLOCATABLE :: Long_out REAL (KIND=r8), DIMENSION (:) , ALLOCATABLE :: Lati_out REAL (KIND=r8), DIMENSION (:,:) , ALLOCATABLE :: XICEFieldOutput REAL (KIND=r8), DIMENSION (:,:) , ALLOCATABLE :: SSTFieldOutput REAL (KIND=r4), DIMENSION (:,:) , ALLOCATABLE :: SSTDumpO REAL (KIND=r4), DIMENSION (:,:) , ALLOCATABLE :: XICEDumpO REAL (KIND=r4), DIMENSION (:,:) , ALLOCATABLE :: tagls(:,:) REAL (KIND=r4) :: FMOD INTEGER :: nv,irec_time,irec_mm,it,iyear INTEGER :: FirstYear,LastYear, FirstMontly,LastMontly,FirstDay,LastDay ,ihour,iday,imon INTEGER :: nfinp=5 ! Standard Read In INTEGER :: nfprt=6 ! Standard Print Out INTEGER :: nfsno=10 ! To Read Unformatted Weekly SoilMoisture Data CHARACTER (LEN=16) :: NCEPName_SST='sst' CHARACTER (LEN=16) :: NCEPName_XICE='icec' CHARACTER (LEN=1024) :: DGDInp,GDASInp_SST,GDASInp_XICE CHARACTER (LEN=2) :: UTC CHARACTER (LEN=4) :: cyear CHARACTER (LEN=10) :: DateLabel ='YYYYMMDDHH' ! Date: yyyymmddhh or DateLabel=' hh' ! If Year (yyyy), Month (mm) and Day (dd) Are Unknown CHARACTER (len = 526) :: FILE_NAME_SST CHARACTER (len = 526) :: FILE_NAME_XICE integer, parameter :: LenDay2Mon(1:12)=(/31,28,31,30,31,30,31,31,30,31,30,31/) CHARACTER(LEN=10) :: DATEC INTEGER :: DAYS INTEGER :: LABS(8) INTEGER :: nsst INTEGER :: iyrst! iyrst - year of start date of analysis INTEGER :: imst! imst - month of start date of analysis INTEGER :: idst! idst - day of start date of analysis INTEGER :: iyrnd! iyrnd - year of end date of analysis INTEGER :: imnd! imnd - month of end date of analysis INTEGER :: idnd! idnd - day of end date of analysis INTEGER :: ndays! ndays - number of days in analysis (start date thru enddate) INTEGER :: index=2! index - analysis version for reference INTEGER :: rec_len CHARACTER(LEN=1) :: asp='"' CALL InitInputParameters () If (.not. Allocated( XICEFieldOutput ) ) ALLOCATE (XICEFieldOutput(iMax,jMax));XICEFieldOutput=0.0 If (.not. Allocated( SSTFieldOutput ) ) ALLOCATE (SSTFieldOutput(iMax,jMax));SSTFieldOutput=0.0 If (.not. Allocated( Long_out ) ) ALLOCATE (Long_out (iMax));Long_out=0.0 If (.not. Allocated( Lati_out ) ) ALLOCATE (Lati_out (jMax));Lati_out=0.0 If (.not. Allocated( SSTDumpO ) ) ALLOCATE (SSTDumpO(iMax,jMax));SSTDumpO=0.0 If (.not. Allocated( XICEDumpO ) ) ALLOCATE (XICEDumpO(iMax,jMax));XICEDumpO=0.0 If (.not. Allocated( tagls ) ) ALLOCATE (tagls(iMax,jMax));tagls=0.0 Long_out(1)=0.125000 DO i=2,iMax Long_out(i)=Long_out(i-1) + 0.25_r8 END DO Lati_out(1)= -89.875 DO j=2,jMax Lati_out(j)=Lati_out(j-1) + 0.25_r8 END DO INQUIRE (IOLENGTH = rec_len)tagls OPEN (24,FILE=TRIM(DirMainInput)//'/'//'lstags.onedeg.dat',FORM='unformatted', & & ACCESS='direct',RECL=rec_len) ! ! Read in land sea tags (1 for ocean; 0 for land) ! READ (24,rec=1) tagls CLOSE(24,STATUS='KEEP') OPEN (36,FILE=TRIM(DirMainOutputmon)//'/'//'sstmtd.nml',FORM='formatted',ACTION='WRITE') WRITE(36,'(A)')' &fnsstnml' WRITE(36,'(A)')" drsst='/gfs/dk12/pkubota/global-1.1.0/datasst/oiv2monthly/ '," INQUIRE(IOLENGTH=lrec)SSTDumpO DateLabel=LabelI DGDInp=TRIM(DirMainInput) UTC='00' UTC=DateLabel(9:10) READ(LabelI(1:4),'(I4.4)')FirstYear READ(LabelF(1:4),'(I4.4)')LastYear READ(LabelI(1:4),'(I4.4)')iyrst READ(LabelI(5:6),'(I2.2)')imst READ(LabelI(7:8),'(I2.2)')idst nsst=0 DO iyear=FirstYear,LastYear irec_mm=0 WRITE(cyear,'(i4.4)')iyear GDASInp_SST=TRIM(NCEPName_SST)//'.day.mean.'//cyear//'.nc' ! Input NOAA Analysis File Name GDASInp_XICE=TRIM(NCEPName_XICE)//'.day.mean.'//cyear//'.nc' ! Input NOAA Analysis File Name FILE_NAME_SST=TRIM(DGDInp)//'/'//TRIM(GDASInp_SST) FILE_NAME_XICE=TRIM(DGDInp)//'/'//TRIM(GDASInp_XICE) ! Close netcdf files CALL Init_Netcdf_Parameter_SST(FILE_NAME_SST) CALL Init_Netcdf_Parameter_XICE(FILE_NAME_XICE) Idim_sst=xSize_sst Jdim_sst=ySize_sst Idim_xice=xSize_xice Jdim_xice=ySize_xice print*,Idim_sst,Jdim_sst,tsize_sst,tsize_xice If (.not. Allocated( SSTDump ) ) ALLOCATE (SSTDump(Idim_sst,Jdim_sst));SSTDump=0.0 If (.not. Allocated( VarField_SST ) ) ALLOCATE (VarField_SST(Idim_sst,Jdim_sst));VarField_SST=0.0 If (.not. Allocated( VarFieldO_SST ) ) ALLOCATE (VarFieldO_SST(Idim_sst,Jdim_sst));VarFieldO_SST=0.0 If (.not. Allocated( XICEDump ) ) ALLOCATE (XICEDump(Idim_xice,Jdim_xice));XICEDump=0.0 If (.not. Allocated( VarField_XICE ) ) ALLOCATE (VarField_XICE(Idim_xice,Jdim_xice));VarField_XICE=0.0 If (.not. Allocated( VarFieldO_XICE ) ) ALLOCATE (VarFieldO_XICE(Idim_xice,Jdim_xice));VarFieldO_XICE=0.0 nv=4 IF(FirstYear == LastYear )THEN READ(LabelI(5:6),'(I2.2)')FirstMontly READ(LabelF(5:6),'(I2.2)')LastMontly ELSE IF (FirstYear < LastYear .and. iyear == FirstYear)THEN READ(LabelI(5:6),'(I2.2)')FirstMontly LastMontly=12 ELSE IF (FirstYear < LastYear .and. iyear == LastYear)THEN FirstMontly=1 READ(LabelF(5:6),'(I2.2)')LastMontly ELSE FirstMontly=1 LastMontly =12 END IF DO imon=FirstMontly,LastMontly irec_mm = irec_mm + 1 IF (FirstMontly == LastMontly .AND. FirstYear == LastYear ) THEN READ(LabelI(7:8),'(I2.2)')FirstDay READ(LabelF(7:8),'(I2.2)')LastDay ELSE IF (iyear == LastYear .AND. imon == LastMontly) THEN FirstDay=1 READ(LabelF(7:8),'(I2.2)')LastDay ELSE IF (iyear == FirstYear .AND. imon == LastMontly ) THEN READ(LabelI(7:8),'(I2.2)')FirstDay FMOD=mod(REAL(iyear),4.0) IF( imon == 2 .AND. FMOD == 0.0 ) THEN LastDay=29 ELSE LastDay=LenDay2Mon(imon) END IF ELSE IF (iyear == FirstYear .AND. imon == FirstMontly ) THEN READ(LabelI(7:8),'(I2.2)')FirstDay FMOD=mod(REAL(iyear),4.0) IF( imon == 2 .AND. FMOD == 0.0 ) THEN LastDay=29 ELSE LastDay=LenDay2Mon(imon) END IF ELSE FirstDay=1 FMOD=mod(REAL(iyear),4.0) IF( imon == 2 .AND. FMOD == 0.0 ) THEN LastDay=29 ELSE LastDay=LenDay2Mon(imon) END IF END IF END IF END IF DO iday=FirstDay,LastDay irec_time=julian_day(iyear, imon, iday) PRINT*,TRIM(GDASInp_SST),iMax,jMax,tsize_sst,irec_time,iday,imon,iyear CALL READ_Netcdf_Field_SST2(VarField_SST,irec_time,nfield=nVarNetcdf_SST(nv)) ! dump data Undef=sfc_sst%var_missing_value VarField_SST=VarField_SST VarFieldO_SST=0.0_r8 CALL INTERP_LAND(Idim_sst,Jdim_sst ,lat0_sst ,lon0_sst ,Idim_sst,Jdim_sst ,lat0_sst ,lon0_sst,Undef,VarField_SST,VarFieldO_SST) VarField_SST=VarFieldO_SST CALL INTERP_LAND(Idim_sst,Jdim_sst ,lat0_sst ,lon0_sst ,Idim_sst,Jdim_sst ,lat0_sst ,lon0_sst,Undef,VarField_SST,VarFieldO_SST) SSTDump=VarFieldO_SST CALL INTERP_LAND(iMax,jMax ,Lati_out ,Long_out ,Idim_sst,Jdim_sst ,lat0_sst ,lon0_sst,Undef,VarFieldO_SST,SSTFieldOutput) SSTDumpO=SSTFieldOutput !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT*,TRIM(GDASInp_XICE),iMax,jMax,tsize_sst,irec_time,iday,imon,iyear CALL READ_Netcdf_Field_XICE2(VarField_XICE,irec_time,nfield=nVarNetcdf_XICE(nv)) ! dump data Undef=sfc_xice%var_missing_value do j=1,Jdim_xice DO i=1,Idim_xice IF(VarField_XICE(i,j) /= Undef)THEN VarField_XICE(i,j)=VarField_XICE(i,j) ELSE VarField_XICE(i,j)=0.0_r8 END IF END DO END DO VarFieldO_XICE=0.0_r8 CALL INTERP_LAND(Idim_xice,Jdim_xice ,lat0_xice ,lon0_xice ,Idim_xice,Jdim_xice ,lat0_xice ,lon0_xice,Undef,VarField_XICE,VarFieldO_XICE) VarField_XICE=VarFieldO_XICE CALL INTERP_LAND(Idim_xice,Jdim_xice ,lat0_xice ,lon0_xice ,Idim_xice,Jdim_xice ,lat0_xice ,lon0_xice,Undef,VarField_XICE,VarFieldO_XICE) XICEDump=VarFieldO_XICE CALL INTERP_LAND(iMax,jMax ,Lati_out ,Long_out ,Idim_xice,Jdim_xice ,lat0_xice ,lon0_xice,Undef,VarFieldO_XICE,XICEFieldOutput) XICEDumpO=XICEFieldOutput do j=1,jMax DO i=1,iMax XICEFieldOutput(i,j)=MIN(MAX(XICEFieldOutput(i,j),0.0_r8),1.0_r8) XICEDumpO(i,j)=MIN(MAX(XICEDumpO(i,j),0.0_r4),1.0_r4) END DO END DO WRITE(DATEC,'(i4.4,2i2.2,a2)') iyear,imon,iday,'00' ihour=0 CALL WRite_MONAN_SST(DATEC,iyear,imon,iday,ihour) OPEN(55,FILE=TRIM(NCEPName_SST)//'_'//TRIM(NCEPName_XICE)//'-'//DATEC//'.bin',ACCESS='DIRECT',FORM='UNFORMATTED', & recl=lrec, ACTION='WRITE', STATUS='UNKNOWN') WRITE(55,rec=1)SSTDumpO WRITE(55,rec=2)XICEDumpO CLOSE(55,STATUS='KEEP') !!!!!!!!!DUMP END DO END DO CALL Finalize_Netcdf_Parameter_SST() END DO stop ' Finalize CALL Init_Netcdf_Parameter_SST' CONTAINS SUBROUTINE WRite_MONAN_SST(DATEC,iyear,imon,iday,ihour) USE Class_SSTtoMONAN, only: SSTtoMONAN integer , intent(in) :: iyear,imon,iday,ihour CHARACTER(LEN=*) :: DATEC integer :: nx integer :: ny character(len=19) :: hdate! '2024-04-02_00:00:00 real :: latitudeNorth real :: longitudeWest real :: IncrementNorth_South real :: IncrementWest_East real :: sst(iMax,jMax) real :: icec(iMax,jMax) character (len=132) :: filename integer :: i,j,ij nx=iMax ny=jMax do j=1,jMax do i=1,iMax ij=ij+1 sst (i,j)=SSTDumpO (i,jMax-j+1)+273.16 icec(i,j)=XICEDumpO(i,jMax-j+1) end do end do latitudeNorth=Lati_out(jMax) longitudeWest=Long_out(iMax) IncrementNorth_South=0.25 IncrementWest_East=0.25 !SST:2023-04-02_00 WRITE(filename,'(A4,I4.4,A1,I2.2,A1,I2.2,A1,I2.2)')'SST:',iyear,'-',imon,'-',iday,'_',ihour WRITE(hdate ,'(I4.4,A1,I2.2,A1,I2.2,A1,I2.2,A6)')iyear,'-',imon,'-',iday,'_',ihour,':00:00' print*,TRIM(filename) print*,TRIM(hdate) call SSTtoMONAN(nx,ny,hdate,latitudeNorth,longitudeWest,& IncrementNorth_South,IncrementWest_East,filename,& sst,icec) END SUBROUTINE WRite_MONAN_SST !---------------------------------------------------- SUBROUTINE INTERP_LAND(nLonO,nLatO,alatO,alonO, nLonI,nLatI,alat,alon, UNDEF,sstI,sstO) IMPLICIT NONE ! read daily IEEE SST file and print selected values. ! sst - sea surface temperature array (deg C) ! anom - sea surface temperature anomalies array (deg C) ! err - standard deviation error of sea surface temperature array (deg C) ! ice - sea ice concentration (percentage) ! iyr - year of analysis ! imo - month of analysis ! ida - day of analysis ! alon - longitude of center of grid square ! alat - latitude of center of grid square ! dall - grid size (0.25) ! ax1 - first longitude (0.125 E) ! ay1 - first latitude (-89.875 or 89.875S) ! nLonI - number of longitudes ! nLatI - number of latitudes INTEGER , INTENT(IN) :: nLonO INTEGER , INTENT(IN) :: nLatO REAL(r8) , INTENT(IN) :: alatO(nLatO) REAL(r8) , INTENT(IN) :: alonO(nLonO) INTEGER , INTENT(IN) :: nLonI INTEGER , INTENT(IN) :: nLatI REAL(r8) , INTENT(IN) :: alon(nLonI) REAL(r8) , INTENT(IN) :: alat(nLatI) REAL(r8) , INTENT(IN) :: UNDEF REAL(r8) , INTENT(IN) :: sstI (nLonI,nLatI) REAL(r8) , INTENT(OUT) :: sstO (nLonO,nLatO) INTEGER(KIND=2) :: anom (nLonI,nLatI) INTEGER(KIND=2) :: err (nLonI,nLatI) INTEGER(KIND=2) :: ice (nLonI,nLatI) REAL (KIND=r8) :: dalat(nLatI) REAL (KIND=r8) :: dalon(nLonI) INTEGER(KIND=4) :: ipt(1) INTEGER(KIND=4) :: jpt(1) INTEGER(KIND=4) :: iptPrev(1) INTEGER(KIND=4) :: jptPrev(1) INTEGER(KIND=4) :: iptNext(1) INTEGER(KIND=4) :: jptNext(1) INTEGER(KIND=4) :: iyr INTEGER(KIND=4) :: imo INTEGER(KIND=4) :: ida REAL (KIND=r8) :: dall REAL (KIND=r8) :: title INTEGER :: i,ii INTEGER :: j,jj ! DO jj=1,nLatO DO ii=1,nLonO DO j=1,nLatI dalat(j)=ABS(alat(j)-alatO(jj)) END DO DO i=1,nLonI dalon(i)=ABS(alon(i)-alonO(ii)) END DO ipt=MINLOC(dalon) jpt=MINLOC(dalat) iptPrev = ipt jptPrev = jpt iptNext = ipt jptNext = jpt DO i=ipt(1),nLonI,1 IF(sstI(i,jpt(1)) == UNDEF)THEN IF(i/=nLonI)iptNext(1) = iptNext(1) + 1 ELSE IF(i/=nLonI)iptNext(1) = iptNext(1) + 1 EXIT END IF END DO DO i=ipt(1),1,-1 IF(sstI(i,jpt(1)) == UNDEF) THEN IF(i/=1)iptPrev(1) = iptPrev(1) - 1 ELSE IF(i/=1)iptPrev(1) = iptPrev(1) - 1 EXIT END IF END DO DO j=jpt(1),nLatI,1 IF(sstI(ipt(1),j) == UNDEF)THEN IF(j/=nLatI)jptNext(1) = jptNext(1) + 1 ELSE IF(j/=nLatI)jptNext(1) = jptNext(1) + 1 EXIT END IF END DO DO j=jpt(1),1,-1 IF(sstI(ipt(1),j) == UNDEF) THEN IF(j/=1)jptPrev(1) = jptPrev(1) - 1 ELSE IF(j/=1)jptPrev(1) = jptPrev(1) - 1 EXIT END IF END DO sstO(ii,jj) =sstI(ipt(1),jpt(1)) !----------------------------------------------- 0 ---------------------------------------------- IF(sstI(iptNext(1),jpt(1)) /= UNDEF .and. sstI(iptPrev(1),jpt(1)) /= UNDEF .and. & sstI(ipt(1),jptNext(1)) /= UNDEF .and. sstI(ipt(1),jptPrev(1)) /= UNDEF) THEN sstO(ii,jj) =( REAL(iptPrev(1))/REAL(iptNext(1)+iptPrev(1))*sstI(iptNext(1),jpt(1)) + & REAL(iptNext(1))/REAL(iptNext(1)+iptPrev(1))*sstI(iptPrev(1),jpt(1)) + & REAL(jptPrev(1))/REAL(jptNext(1)+jptPrev(1))*sstI(ipt(1),jptNext(1)) + & REAL(jptNext(1))/REAL(jptNext(1)+jptPrev(1))*sstI(ipt(1),jptPrev(1)) )/2.0 !----------------------------------------------- 1 ---------------------------------------------- ELSE IF(sstI(iptNext(1),jpt(1)) == UNDEF .and. sstI(iptPrev(1),jpt(1)) /= UNDEF .and. & sstI(ipt(1),jptNext(1)) /= UNDEF .and. sstI(ipt(1),jptPrev(1)) /= UNDEF) THEN sstO(ii,jj) =( sstI(iptPrev(1),jpt(1)) + & REAL(jptPrev(1))/REAL(jptNext(1)+jptPrev(1))*sstI(ipt(1),jptNext(1)) + & REAL(jptNext(1))/REAL(jptNext(1)+jptPrev(1))*sstI(ipt(1),jptPrev(1)) )/2.0 ELSE IF(sstI(iptNext(1),jpt(1)) /= UNDEF .and. sstI(iptPrev(1),jpt(1)) == UNDEF .and. & sstI(ipt(1),jptNext(1)) /= UNDEF .and. sstI(ipt(1),jptPrev(1)) /= UNDEF) THEN sstO(ii,jj) =( sstI(iptNext(1),jpt(1)) + & REAL(jptPrev(1))/REAL(jptNext(1)+jptPrev(1))*sstI(ipt(1),jptNext(1)) + & REAL(jptNext(1))/REAL(jptNext(1)+jptPrev(1))*sstI(ipt(1),jptPrev(1)) )/2.0 ELSE IF (sstI(iptNext(1),jpt(1)) /= UNDEF .and. sstI(iptPrev(1),jpt(1)) /= UNDEF .and. & sstI(ipt(1),jptNext(1)) == UNDEF .and. sstI(ipt(1),jptPrev(1)) /= UNDEF) THEN sstO(ii,jj) =( REAL(iptPrev(1))/REAL(iptNext(1)+iptPrev(1))*sstI(iptNext(1),jpt(1)) + & REAL(iptNext(1))/REAL(iptNext(1)+iptPrev(1))*sstI(iptPrev(1),jpt(1)) + & sstI(ipt(1),jptPrev(1)) )/2.0 ELSE IF(sstI(iptNext(1),jpt(1)) /= UNDEF .and. sstI(iptPrev(1),jpt(1)) /= UNDEF .and. & sstI(ipt(1),jptNext(1)) /= UNDEF .and. sstI(ipt(1),jptPrev(1)) == UNDEF) THEN sstO(ii,jj) =( REAL(iptPrev(1))/REAL(iptNext(1)+iptPrev(1))*sstI(iptNext(1),jpt(1)) + & REAL(iptNext(1))/REAL(iptNext(1)+iptPrev(1))*sstI(iptPrev(1),jpt(1)) + & sstI(ipt(1),jptNext(1)))/2.0 !----------------------------------------------- 2 ---------------------------------------------- ELSE IF(sstI(iptNext(1),jpt(1)) == UNDEF .and. sstI(iptPrev(1),jpt(1)) == UNDEF .and. & sstI(ipt(1),jptNext(1)) /= UNDEF .and. sstI(ipt(1),jptPrev(1)) /= UNDEF) THEN sstO(ii,jj) =( & REAL(jptPrev(1))/REAL(jptNext(1)+jptPrev(1))*sstI(ipt(1),jptNext(1)) + & REAL(jptNext(1))/REAL(jptNext(1)+jptPrev(1))*sstI(ipt(1),jptPrev(1)) ) ELSE IF(sstI(iptNext(1),jpt(1)) /= UNDEF .and. sstI(iptPrev(1),jpt(1)) == UNDEF .and. & sstI(ipt(1),jptNext(1)) == UNDEF .and. sstI(ipt(1),jptPrev(1)) /= UNDEF) THEN sstO(ii,jj) =( sstI(iptNext(1),jpt(1)) + sstI(ipt(1),jptPrev(1)) )/2.0 ELSE IF(sstI(iptNext(1),jpt(1)) /= UNDEF .and. sstI(iptPrev(1),jpt(1)) /= UNDEF .and. & sstI(ipt(1),jptNext(1)) == UNDEF .and. sstI(ipt(1),jptPrev(1)) == UNDEF) THEN sstO(ii,jj) =( REAL(iptPrev(1))/REAL(iptNext(1)+iptPrev(1))*sstI(iptNext(1),jpt(1)) + & REAL(iptNext(1))/REAL(iptNext(1)+iptPrev(1))*sstI(iptPrev(1),jpt(1)) ) ELSE IF(sstI(iptNext(1),jpt(1)) == UNDEF .and. sstI(iptPrev(1),jpt(1)) /= UNDEF .and. & sstI(ipt(1),jptNext(1)) /= UNDEF .and. sstI(ipt(1),jptPrev(1)) == UNDEF) THEN sstO(ii,jj) =( sstI(iptPrev(1),jpt(1)) + sstI(ipt(1),jptNext(1)) )/2.0 !----------------------------------------------- 2 x 2---------------------------------------------- ELSE IF(sstI(iptNext(1),jpt(1)) == UNDEF .and. sstI(iptPrev(1),jpt(1)) /= UNDEF .and. & sstI(ipt(1),jptNext(1)) == UNDEF .and. sstI(ipt(1),jptPrev(1)) /= UNDEF) THEN sstO(ii,jj) =( sstI(iptPrev(1),jpt(1)) + sstI(ipt(1),jptPrev(1)) )/2.0 ELSE IF(sstI(iptNext(1),jpt(1)) /= UNDEF .and. sstI(iptPrev(1),jpt(1)) == UNDEF .and. & sstI(ipt(1),jptNext(1)) /= UNDEF .and. sstI(ipt(1),jptPrev(1)) == UNDEF) THEN sstO(ii,jj) =( sstI(iptNext(1),jpt(1)) + sstI(ipt(1),jptNext(1)) )/2.0 !----------------------------------------------- 3 x 3---------------------------------------------- ELSE IF(sstI(iptNext(1),jpt(1)) == UNDEF .and. sstI(iptPrev(1),jpt(1)) == UNDEF .and. & sstI(ipt(1),jptNext(1)) == UNDEF .and. sstI(ipt(1),jptPrev(1)) /= UNDEF) THEN sstO(ii,jj) =( sstI(ipt(1),jptPrev(1)) ) ELSE IF(sstI(iptNext(1),jpt(1)) /= UNDEF .and. sstI(iptPrev(1),jpt(1)) == UNDEF .and. & sstI(ipt(1),jptNext(1)) == UNDEF .and. sstI(ipt(1),jptPrev(1)) == UNDEF) THEN sstO(ii,jj) =( sstI(iptNext(1),jpt(1)) ) ELSE IF(sstI(iptNext(1),jpt(1)) == UNDEF .and. sstI(iptPrev(1),jpt(1)) /= UNDEF .and. & sstI(ipt(1),jptNext(1)) == UNDEF .and. sstI(ipt(1),jptPrev(1)) == UNDEF) THEN sstO(ii,jj) =( sstI(iptPrev(1),jpt(1)) ) ELSE IF(sstI(iptNext(1),jpt(1)) == UNDEF .and. sstI(iptPrev(1),jpt(1)) == UNDEF .and. & sstI(ipt(1),jptNext(1)) /= UNDEF .and. sstI(ipt(1),jptPrev(1)) == UNDEF) THEN sstO(ii,jj) =( sstI(ipt(1),jptNext(1)) ) !----------------------------------------------- 2 x 2---------------------------------------------- ELSE IF(sstI(iptNext(1),jpt(1)) == UNDEF .and. sstI(iptPrev(1),jpt(1)) == UNDEF .and. & sstI(ipt(1),jptNext(1)) /= UNDEF .and. sstI(ipt(1),jptPrev(1)) == UNDEF) THEN sstO(ii,jj) = sstI(ipt(1),jptNext(1)) ELSE IF(sstI(iptNext(1),jpt(1)) == UNDEF .and. sstI(iptPrev(1),jpt(1)) == UNDEF .and. & sstI(ipt(1),jptNext(1)) == UNDEF .and. sstI(ipt(1),jptPrev(1)) /= UNDEF) THEN sstO(ii,jj) = sstI(ipt(1),jptPrev(1)) END IF END DO END DO PRINT*,'pk check var',MAXVAL(sstO),MINVAL(sstO) RETURN !print *,' ' !WRITE(nameo(1:28),'(A7,I2.2,A9,I4.4,i2.2,i2.2,i2.2)')'gdas1.T',ihr,'Z.sstgrd.',iyr,imo,ida,ihr !print*, nameo !OPEN(10,FILE=TRIM(nameo(1:28)),FORM='UNFORMATTED',& ! ACCESS='SEQUENTIAL',STATUS='UNKNOWN',ACTION='WRITE',IOSTAT=error) !WRITE(10)273+REAL(sstI/100.0,kind=4) !STOP print*, title print*, 'SST, SST anomalies and error are in deg-C x 100' print*,' SST date: year =',iyr,' month =',imo,' day =',ida ! .... loop thru several longitudes and latitudes and print out SSTs do i = 1,nLonI,400 do j = 1,nLatI,200 print *, 'lon = ',alon(i),' lat = ',alat(j),& ' sst = ',sstI(i,j),' anom = ',anom(i,j), & ' err = ',err(i,j),' ice = ',ice(i,j) enddo print *,' ' enddo print *,'Longitudes are in degrees E (positive)' print *,' and increase from i=1, ',alon(1),& 'to i=nLonI,',alon(nLonI) print *,'Latitudes are in degrees S (negative) and N (positive)' print *,' and increase from j=1,',alat(1),'to j=nLatI,',alat(nLatI) print *,'The grid interval =',dall print *,' All arrays is (nLonI,nLatI)' print *,' the first index is longitude',' the second is latitude' stop 1 WRITE(6,302) 302 FORMAT (' WARNING! - PREMATURE END OF INPUT DATA: stop 100') RETURN END SUBROUTINE INTERP_LAND !SUBROUTINESUBROUTINESUBROUTINESUBROUTINESUBROUTINESUBROUTINESUBROUTINESUBROUTINESUBROUTINESUBROUTINE INTEGER FUNCTION getpoint(coord,locate) IMPLICIT NONE REAL(KIND=r8), INTENT(IN ) :: coord(:) REAL(KIND=r8), INTENT(IN ) :: locate REAL(KIND=r8) :: GeomDist(SIZE(coord)) INTEGER :: npoint(1) GeomDist =ABS(coord-locate) npoint =MINLOC(GeomDist) getpoint =npoint(1) !PRINT*,'locate=',locate,'getpoint=',getpoint, 'coord',coord END FUNCTION getpoint END PROGRAM AOI_SSTNOAA