SUBROUTINE read_Surface(mype,lunin,regional_time,istart,jstart,nlon,nlat,& numsao,NVARCLD_P,OI,OJ,OCLD,OWX,Oelvtn,Odist,cstation, & OIstation,OJstation) ! !$$$ subprogram documentation block ! . . . . ! subprogram: read_Surface read in cloud observations in surface observation ! ! PRGMMR: Ming Hu ORG: GSD/AMB DATE: 2006-10-30 ! ! ABSTRACT: ! This subroutine read in cloud observations in surface observation ! ! PROGRAM HISTORY LOG: ! 2009-01-20 Hu Add NCO document block ! ! ! input argument list: ! mype - processor ID ! lunin - unit in which data are read in ! regional_time - analysis time ! jstart - start lon of the whole array on each pe ! istart - start lat of the whole array on each pe ! nlon - no. of lons on subdomain (buffer points on ends) ! nlat - no. of lats on subdomain (buffer points on ends) ! numsao - maximum observation number (observation number) ! NVARCLD_P - first dimension of OLCD ! ! output argument list: ! ! OI - observation x location ! OJ - observation y location ! OLCD - cloud amount, cloud height, visibility ! OWX - weather observation ! Oelvtn - observation elevation ! Odist - distance from the nearest station ! cstation - station name ! ! USAGE: ! INPUT FILES: ! ! OUTPUT FILES: ! ! ! REMARKS: ! ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE: Linux cluster (WJET) ! !$$$ ! use kinds, only: r_single,i_kind,r_kind,r_double implicit none integer(i_kind), intent(in) :: mype integer(i_kind), intent(in) :: lunin integer(i_kind), intent(in) :: regional_time(6) integer(i_kind), intent(in) :: istart integer(i_kind), intent(in) :: jstart INTEGER(i_kind), intent(in) :: nlon,nlat INTEGER(i_kind), intent(in) :: numsao INTEGER(i_kind), intent(in) :: NVARCLD_P real(r_single), intent(out) :: OI(numsao) ! x location, grid real(r_single), intent(out) :: OJ(numsao) ! y location, grid INTEGER(i_kind), intent(out) :: OCLD(NVARCLD_P,numsao) ! cloud amount, cloud height, ! visibility CHARACTER*10, intent(out) :: OWX(numsao) ! weather real(r_single), intent(out) :: Oelvtn(numsao) ! elevation real(r_single), intent(out) :: Odist(numsao) ! distance from the nearest station character(8), intent(out) :: cstation(numsao) ! station name real(r_single), intent(out) :: OIstation(numsao) ! x location, station real(r_single), intent(out) :: OJstation(numsao) ! y location, station ! ! temp. ! character*12 :: adate character*9 :: STANAM ! stattion name real(r_single) :: LAT ! latitude real(r_single) :: LON ! longitude real(r_single) :: VIS ! horizontal visibility real(r_single) :: CLD(3) ! cloud base height character*10 :: WX ! weather character*8 :: sky(3) ! cloud cover or amount ! ! misc. ! real(r_kind),allocatable,dimension(:,:):: data_s logical,allocatable,dimension(:):: luse character(10) :: obstype integer(i_kind):: nreal,nchanl character(20) :: isis INTEGER(i_kind) :: nn_obs real(r_kind) :: cldamt,awx,cldhgt character*3 :: msky,mwx INTEGER(i_kind) :: i,j,k,k2,ic,jb,ib integer(i_kind) :: start, end real(r_kind) :: spval_p parameter (spval_p = 99999.) real(r_double) rstation_id character(8) :: cstation1,cc,ci equivalence(cstation1,rstation_id) !==================================================================== ! Begin OWX='' OCLD=-99999 ib=jstart ! begin i point of this domain jb=istart ! begin j point of this domain ! read(lunin) obstype,isis,nreal,nchanl nn_obs = nreal + nchanl allocate(luse(numsao),data_s(nn_obs,numsao)) read(lunin) data_s, luse ! ! read in ruface observations: ! station name, x location, y location, longitude, latitude, elevation ! visibility, cloud amount, cloud height, weather ! DO i=1,numsao rstation_id=data_s(1,i) cstation(i)=cstation1 OI(i) = data_s(2,i) - ib + 2 ! covert it to the local grid OJ(i) = data_s(3,i) - jb + 2 ! covert it to the local grid if( OI(i) < 1 .or. OI(i) > nlon ) write(6,*) 'read_Surface: Error in reading ii:',mype,OI(i),ib,jb if( OJ(i) < 1 .or. OJ(i) > nlat ) write(6,*) 'read_Surface: Error in reading jj:',mype,OJ(i),ib,jb Oelvtn(i) = data_s(4,i) Odist(i) = data_s(23,i) OIstation(i) = data_s(24,i) OJstation(i) = data_s(25,i) if(data_s(22,i) > 50 ) cycle ! do not use this data VIS = data_s(5,i) ! cloud amonut and base height ! C 020011 ! 0 0 oktas (0/10) ! 1 1 okta or less, but not zero (1/10 or less, but not zero) ! 2 2 oktas (2/10 - 3/10) ! 3 3 oktas (4/10) ! 4 4 oktas (5/10) ! 5 5 oktas (6/10) ! 6 6 oktas (7/10 - 8/10) ! 7 7 oktas or more, but not 8 oktas (9/10 or more, but not 10/10) ! 8 8 oktas (10/10) ! 9 Sky obscured by fog and/or other meteorological phenomena ! 10 Sky partially obscured by fog and/or other meteorological phenomena ! 11 Scattered ! 12 Broken ! 13 Few ! 14 Reserved ! 15 Cloud cover is indiscernible for reasons other than ! fog or other meteorological phenomena, or observation is not made DO j=1,3 cldamt = data_s(5+j,i) ! cloud amount cldhgt = int(data_s(11+j,i)) ! cloud bottom height if(cldamt < spval_p .and. cldhgt < spval_p) then if(abs(cldamt-0._r_kind) < 0.0001_r_kind) then OCLD(j,i)=0 !msky='CLR' cldhgt=spval_p elseif(abs(cldamt-13._r_kind) < 0.0001_r_kind) then OCLD(j,i)=1 !msky='FEW' elseif(abs(cldamt-11._r_kind) < 0.0001_r_kind) then OCLD(j,i)=2 !msky='SCT' elseif(abs(cldamt-12._r_kind) < 0.0001_r_kind) then OCLD(j,i)=3 !msky='BKN' elseif((abs(cldamt-8._r_kind) < 0.0001_r_kind) .or. & (abs(cldamt-9._r_kind) < 0.0001_r_kind)) then OCLD(j,i)=4 ! msky='OVC' msky='VV ' elseif(abs(cldamt-1._r_kind) < 0.0001_r_kind) then OCLD(j,i)=1 elseif(abs(cldamt-2._r_kind) < 0.0001_r_kind .or. & abs(cldamt-3._r_kind) < 0.0001_r_kind ) then OCLD(j,i)=2 elseif(cldamt > 3.5_r_kind .and. cldamt < 6.5_r_kind ) then OCLD(j,i)=3 elseif(abs(cldamt-7._r_kind) < 0.0001_r_kind ) then OCLD(j,i)=4 else OCLD(j,i) = spval_p ! wrong cloud observation type cldhgt = spval_p endif if(cldhgt > 0.0_r_kind ) then OCLD(6+j,i) = cldhgt else OCLD(j,i) = spval_p OCLD(6+j,i) = spval_p endif else OCLD(j,i) = 99 OCLD(6+j,i) = spval_p endif enddo ! j ! weather DO j=1,3 awx = data_s(17+j,i) ! weather mwx=' ' if(awx>=10._r_kind .and.awx<=12._r_kind ) mwx='BR ' if(awx>=110._r_kind.and.awx<=112._r_kind) mwx='BR ' if(awx==5._r_kind .or. awx==105._r_kind) mwx='HZ ' if(awx>=40._r_kind .and.awx<=49._r_kind ) mwx='FG ' if(awx>=130._r_kind.and.awx<=135._r_kind) mwx='FG ' if(awx>=50._r_kind .and.awx<=59._r_kind ) mwx='DZ ' if(awx>=150._r_kind.and.awx<=159._r_kind) mwx='DZ ' if(awx>=60._r_kind .and.awx<=69._r_kind ) mwx='RA ' if(awx>=160._r_kind.and.awx<=169._r_kind) mwx='RA ' if(awx>=70._r_kind .and.awx<=78._r_kind ) mwx='SN ' if(awx>=170._r_kind.and.awx<=178._r_kind) mwx='SN ' if(awx==79._r_kind .or. awx==179._r_kind) mwx='PE ' if(awx>=80._r_kind .and.awx<=90._r_kind ) mwx='SH ' if(awx>=180._r_kind.and.awx<=187._r_kind) mwx='SH ' if(awx>=91._r_kind .and.awx<=99._r_kind ) mwx='TH ' if(awx>=190._r_kind.and.awx<=196._r_kind) mwx='TH ' if (j==1) start=1 if (j==2) start=4 if (j==3) start=7 end=start+2 OWX(i)(start:end)=mwx enddo ! visiblity IF(VIS > spval_P) then OCLD(13,i)=spval_P else IF(VIS > 100.0_r_kind ) then OCLD(13,i)=int(VIS) elseif(VIS <=100.0_r_kind .and. VIS > 0.0_r_kind ) then OCLD(13,i)=100 ! write(6,*) 'read_Surface, Warning: change visibility to 100 m !!!' ENDIF endif ENDDO ! i = numsao ! END SUBROUTINE read_Surface