MODULE mpobs use mkinds use mgrid use mncio use mspmd!, only : pid IMPLICIT NONE character(len=cl) :: at_sla_data_location character(len=cl) :: sla_data_location character(len=cl) :: sst_data_location character(len=cl) :: tsis_obs_location character(len=cl) :: clim_data_location character(len=cl) :: fclim_profile_location character(len=cl) :: wod_profiles_location character(len=cl) :: raw_argo_profiles_location character(len=cl) :: argo_tsidb_location INTEGER(i4),parameter :: mxobs=1000000,nobs_typ=4 CHARACTER(LEN=3),dimension(8) :: altimid !=(/'j2','j1','j1g','cf','enn','en','gf','tp'/) REAL(r4),dimension(8) :: altimerr=(/0.04,0.04,0.04,0.04,0.05,0.05,0.05,0.05/) REAL(r4),allocatable :: amdt(:,:) TYPE tobs INTEGER(i4) :: id CHARACTER(Len=3) :: typ INTEGER(i4) :: pid REAL(r4) :: lon REAL(r4) :: lat INTEGER(i4) :: lvl REAL(r4) :: time REAL(r4) :: age REAL(r4) :: val REAL(r4) :: err REAL(r4) :: bkg REAL(r4) :: fcst REAL(r4) :: clim REAL(r4) :: cstd REAL(r4) :: inov REAL(r4) :: res REAL(r4) :: gridi REAL(r4) :: gridj REAL(r4) :: dist REAL(r4) :: anom REAL(r4) :: raw_val END TYPE tobs TYPE ts_obs_ingrid integer(i4) :: num_obs real(r4),allocatable :: rdist(:) integer(i4),allocatable :: gptobs(:) integer(i4) :: seen end type ts_obs_ingrid INTEGER(i4) :: nobs,nactiveobs,ntobs type (tobs), allocatable :: obs(:),robs(:),aobs(:),gobs(:) type (tobs), allocatable :: work_obs(:),work_obs1(:),work_obs2(:),work_obs3(:),work_obs4(:) type (tobs), allocatable :: work_pobs(:,:,:),ptobs(:),sobs(:),pobs(:,:),profile_obs(:,:,:) INTEGER(i4), allocatable :: nvalidId(:),nactiveId(:) real(r4), allocatable :: gridded_sst(:,:),gridded_sst_err(:,:),gridded_fld(:,:,:),gridded_fld_err(:,:,:) real(r4), allocatable :: hcscl(:,:),hcscl_lon(:),hcscl_lat(:) integer(i4) :: nsla,nsst,nuvl,nvvl,ndays_lkbk REAL(r4) :: sla_offset,sla_inov_threshold,sla_super_size type (ts_obs_ingrid), allocatable :: obs_for_gpt(:,:) ! sst file name character(cl) :: gridded_sst_file_pfx,gridded_sla_file_pfx integer(i4) :: sst_smooth_factor ! profile data parameters character(cl) :: argoloc ! location of argo profiles real(r4) :: drho_tol ! inversion tolerance real(r4) :: nsig ! no of std deviations to discard obs real(r4) :: frac_outliers ! no of outliers allowed per profile real(r4) :: bot_check_tol ! check for bottom real(r4) :: sgrd_size ! superobs grid size integer(i4) :: twin_start ! time start lookback integer(i4) :: twin_end ! time end logical(bl) :: lsuper ! super obs or not real(r4) :: taucorr ! obs error correlation time ! horizontal scale info CHARACTER(cl) :: hcsclfile ! file containing horizontal correlation scales integer(i4) :: rnx,rny ! grid sze for horizontal correlation scales contains subroutine read_profile_params() NAMELIST /profile_params/drho_tol,nsig,frac_outliers,bot_check_tol,sgrd_size,twin_start,twin_end,lsuper,taucorr OPEN(21,FILE='tsis.nlist') READ(21,NML=profile_params) CLOSE(21) end subroutine SUBROUTINE initialize_obs_vector IMPLICIT NONE allocate(obs_for_gpt(nx,ny)) allocate(gobs(mxobs)) CALL getmdt(start,count) ntobs=0 nobs=0 nactiveobs=0 !if(pid==0) write(*,*) "....initialized and loaded obs vector" !if(pid==0) Write(*,*) "....in memory obs vector size (MB)....", 2.0*size(gobs)*4./1024./1024. END SUBROUTINE SUBROUTINE initialize_pobs_vector IMPLICIT NONE allocate(work_pobs(nobs_typ,nz,mxobs)) !allocate(obs_for_gpt(nx,ny)) !CALL getmdt(start,count) !ntobs=0 !write(*,*) "....initialized and loaded obs vector" !Write(*,*) "....in memory obs vector size (MB)....", 2.0*size(gobs)*4./1024./1024. END SUBROUTINE subroutine read_obs_location() NAMELIST /obs_database_location/at_sla_data_location,sla_data_location,sst_data_location,tsis_obs_location,clim_data_location,raw_argo_profiles_location,argo_tsidb_location OPEN(21,FILE='tsis.nlist') READ(21,NML=obs_database_location) !if(PID==0)write(*,obs_database_location) CLOSE(21) end subroutine SUBROUTINE read_obs_window() IMPLICIT NONE NAMELIST /obs_window/lnmn,lnmx,ltmn,ltmx ! read analysis parameters OPEN(21,FILE='tsis.nlist') READ(21,NML=obs_window) CLOSE(21) !IF (lnmn<0.0) lnmn=lnmn+360.0 !IF (lnmx<0.0) lnmx=lnmx+360.0 END SUBROUTINE SUBROUTINE read_prep_params() IMPLICIT NONE NAMELIST /prep_params/sla_inov_threshold,sla_super_size,gridded_sla_file_pfx,twin_start,twin_end ! read analysis parameters OPEN(21,FILE='tsis.nlist') READ(21,NML=prep_params) CLOSE(21) !IF (lnmn<0.0) lnmn=lnmn+360.0 !IF (lnmx<0.0) lnmx=lnmx+360.0 END SUBROUTINE SUBROUTINE read_sst_prep_params() IMPLICIT NONE NAMELIST /sst_prep_params/gridded_sst_file_pfx,sst_smooth_factor ! read analysis parameters OPEN(21,FILE='tsis.nlist') READ(21,NML=sst_prep_params) CLOSE(21) END SUBROUTINE SUBROUTINE set_obs_grid_bounds(start,count,cdtg) USE mdates IMPLICIT NONE INTEGER(i4) :: start(3) INTEGER(i4) :: count(3) CHARACTER(LEN=*) :: cdtg real(r4) :: ltgmn,ltgmx,analysis_time call CDATE2WNDAY(analysis_time,cdtg) timebnds(1)=analysis_time+twin_start timebnds(2)=analysis_time+twin_end timebnds(3)=analysis_time CALL read_obs_window() lonbnds(1)=max(lnmn,minval(mlon(:,1))) lonbnds(2)=min(lnmx,maxval(mlon(:,1))) latbnds(1)=max((ltmn),(minval(mlat(1,:)))) latbnds(2)=min((ltmx),(maxval(mlat(1,:)))) !js=max(1,jfp-10) !je=min(ny,jlp+10) !ltgmn=max(ltmn,mlat(1,js)) !ltgmx=min(ltmx,mlat(1,je)) !latbnds(1)=max(ltmn,max(ltgmn,minval(mlat(1,:)))) !latbnds(2)=min(ltmx,min(ltgmx,maxval(mlat(1,:)))) !print *, js,je,minval(mlat(1,js:je)),maxval(mlat(1,js:je)) !print *, latbnds(1),latbnds(2),lonbnds(1),lonbnds(2) !print *, pid, jfp,jlp !call stop_spmd() !stop END SUBROUTINE Subroutine getmdt(start,count) implicit none INTEGER(i4) :: start(3) INTEGER(i4) :: count(3) !local variables integer(kind=i4) :: fid CHARACTER(LEN=6),parameter :: mdtfile='mdt.nc' LOGICAL(bl) :: mdt_exists INQUIRE(FILE=mdtfile, EXIST=mdt_exists) IF (mdt_exists) then allocate(amdt(count(1),count(2))) !WRITE(*,*) "....reading mean dynamic topography from....", trim(mdtfile) call nciopn(trim(mdtfile),fid) call nciorv(trim(mdtfile),fid,"mdt",amdt,(/start(1),start(2)/),(/count(1),count(2)/)) CALL nciocl(trim(mdtfile),fid) ELSE !Write(*,*) "File not found: ", trim(mdtfile) ENDIF end subroutine Subroutine sethcscl() implicit none !local variables integer(kind=i4) :: fid LOGICAL(bl) :: hcscl_exists NAMELIST /hcscl_params/hcsclfile,rnx,rny OPEN(21,FILE='tsis.nlist') READ(21,NML=hcscl_params) CLOSE(21) INQUIRE(FILE=hcsclfile, EXIST=hcscl_exists) IF (hcscl_exists) then allocate(hcscl(rnx,rny)) allocate(hcscl_lon(rnx),hcscl_lat(rny)) !WRITE(*,*) "....reading mean dynamic topography from....", trim(mdtfile) call nciopn(trim(hcsclfile),fid) call nciorv(trim(hcsclfile),fid,"lon",hcscl_lon) call nciorv(trim(hcsclfile),fid,"lat",hcscl_lat) call nciorv(trim(hcsclfile),fid,"rossby",hcscl) CALL nciocl(trim(hcsclfile),fid) ELSE IF (PID==0) Write(*,*) "Spatial Scale File not found will use defaults" hcscl=150.0 ENDIF end subroutine REAL(r4) Function setaltimErr(caltim) CHARACTER(len=*),intent(in) :: caltim INTEGER(i4) :: i setaltimErr=0.05 ! default do i=1,size(altimid) if(trim(caltim) .eq. trim(altimid(i))) then setaltimErr=altimerr(i) endif enddo end Function setaltimErr END MODULE