module mtsis use mkinds use mgrid use mstate use mpobs use mprep use mutil use mens use mrls use mspmd use mdates !use mpost use miotsis use mhycom !use mseawater !use msupport implicit none character(len=10) :: cdtg logical(bl) :: lobs integer(i4) :: mnloc(2),imn,jmn,nob_grp,ip,jp,j,pkmin,pkmax,icount,fid real(r4),parameter :: spval=2.00**100 real(r4),allocatable :: stime(:),ob_grp_present(:) character(2) :: lin logical(bl) :: lexist,lprofile,lsla,lsst,lasla character(:),allocatable :: var,ncfile,fname logical(bl),parameter :: ltides=.false. contains subroutine initialize_tsis() implicit none ! initialize analysis grid first for spmd processing call initialize_analysis_grid() call start_spmd() call spmd_distribute() !call set analysis date call set_analysis_date(cdtg) call set_model_info() !print *, ifp,ilp,jfp,jlp !call stop_spmd() !stop ! initialize observations call read_obs_location() call set_obs_grid_bounds(start,count,cdtg) call initialize_obs_vector() !IF(PID==0) write(*,*) "....sla_data_location...." , trim(sla_data_location) !IF(PID==0) write(*,*) "....sst_data_location...." , trim(sst_data_location) !IF(PID==0) write(*,*) "....insitu_data_location...." , trim(insitu_data_location) !IF(PID==0) write(*,*) "....clim_data_location...." , trim(clim_data_location) !IF(PID==0) write(*,*) "....clim_profile_location...." , trim(fclim_profile_location) !IF(PID==0) write(*,*) "....wod_profiles_location...." , trim(wod_profiles_location) ! allocate and load forecast IF(PID==0) THEN write(*,*) "....forecast model is ...." , fcmodel !INQUIRE(FILE="restart_out.a", EXIST=lexist) !IF(lexist) then call malloc_state(start,count) call malloc_astate(start,count) call getFCstate(FCFileName,fcmodel,ltides) assh=fssh athk=fthk asal=fsal atem=ftem apin=fpin fathk=fthk aden=fden !!Alex store fmgp amgp=fmgp !ELSE ! call stop_spmd() ! write(*,*) "....no restart file ...." ! stop ENDIF !ENDIF IF(PID==0) write(*,*) "....forecast file is ...." , FCFileName IF(PID==0) write(*,*) "....grid dimensions ...." , nx,ny,nz IF(PID==0) write(*,*) "....eqn of state ...." , sigver IF(PID==0) write(*,*) "....no of processing elements ...." , npes IF(PID==0) write(*,*) "....average size of subdivided domain ...." ,nx,(jlp-jfp) ! allocate forecast store allocate(work2d(nx,ny,3)) allocate(fcst(nx,ny,3)) allocate(b(nx,ny,3)) allocate(e(nx,ny,3)) allocate(idx(nx,ny)) allocate(varb(nx,ny,3)) allocate(ists(nx,ny)) ! read analysis parameters nob_grp=4 allocate(ob_grp_present(nob_grp)) fname=trim(tsis_obs_location)//"/tsis_obs_"//trim(mpfx)//"_"//cdtg//".nc" call nciopn(fname,fid) call nciorv(fname,fid,"ob_grp_present",ob_grp_present) call nciocl(fname,fid) lsla=.false. lsst=.false. lprofile=.false. lasla=.false. if(ob_grp_present(1)==1) lprofile=.true. if(ob_grp_present(2)==1) lsla=.true. if(ob_grp_present(3)==1) lsst=.true. if(ob_grp_present(4)==1) lasla=.true. IF(PID==0) write(*,*) ".... Profile available ...." , lprofile ! treat all point as active !ists=1 call read_analysis_parameters() IF(PID==0) write(*,*) "....loaded forecast state...." IF(PID==0) write(*,*) "....initialization complete...." !call initEns2d(ens,cdtg) !call init_nisp() call init_stat(mpfx) call spmd_wait() end subroutine initialize_tsis subroutine do_mgrid_profile_analysis() character(:),allocatable :: var,ncfile,fname integer(i4) :: k,m,fid,ivar,i,ii,jj if(lprofile) then call init_pobs(cdtg,nobs,mpfx) do k=1,nz write(lin,'(i2.2)') k ! do temp var="tem" ivar=1 m=0 b=0.0 work2d(:,:,1)=0.0 call pobs2mgrid(nobs,ivar,k,b(:,:,1),e(:,:,1),idx,nx,ny) !if(sum(idx)>10.) then call get_varb(mpfx,var,varb,k) IF(PID==0) fcst(:,:,1)=atem(:,:,k) call spmd_bcast_array(fcst(:,:,1),0) where(b(:,:,1)<0.5*spval .and. mdepth10.0) b(:,:,1)=spval !if(pid==0) print *,"temp: ", k,minval(b(:,:,1),mask=b(:,:,1)5.0) then ! write(*,*) "temp: ",maxval(abs(work2d(:,:,1))), maxloc(abs(work2d(:,:,1))) !where(abs(work2d(:,:,1))>5.0) work2d(:,:,1)=0.0 ! endif !!Alex change ftem for atem ! atem(:,:,k)=ftem(:,:,k)+work2d(:,:,1) atem(:,:,k)=atem(:,:,k)+work2d(:,:,1) ! ncfile="test_tem.nc" !call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),work2d(:,:,1),"tem","temperature updates","degC",nx,ny,1,1) ! call ncfldij(ncfile,work2d(:,:,1),"tem","temperature updates","degC",nx,ny) ENDIF ! do saln var="sal" ivar=2 m=0 b=0. work2d(:,:,1)=0.0 call pobs2mgrid(nobs,ivar,k,b(:,:,1),e(:,:,1),idx,nx,ny) call get_varb(mpfx,var,varb,k) IF(PID==0) fcst(:,:,1)=asal(:,:,k) call spmd_bcast_array(fcst(:,:,1),0) where(b(:,:,1)<0.5*spval .and. mdepth4.0) b(:,:,1)=spval !if(pid==0) print *,"saln: ", k,minval(b,mask=b3.0) then ! write(*,*) "saln: ",maxval(abs(work2d(:,:,1))), maxloc(abs(work2d(:,:,1))) !where(abs(work2d(:,:,1))>3.0) work2d(:,:,1)=0.0 ! endif !!Alex change fsal for asal ! asal(:,:,k)=fsal(:,:,k)+work2d(:,:,1) asal(:,:,k)=asal(:,:,k)+work2d(:,:,1) ! ncfile="test_sal.nc" ! call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),work2d(:,:,1),"sal","salinity updates","psu",nx,ny,1,1) ENDIF call spmd_wait() ! do dp analysis var="pin" ivar=4 m=0 b=0. work2d(:,:,1)=0.0 call pobs2mgrid(nobs,ivar,k,b(:,:,1),e(:,:,1),idx,nx,ny) call get_varb(mpfx,var,varb,k) IF(PID==0) fcst(:,:,1)=fpin(:,:,k) call spmd_bcast_array(fcst(:,:,1),0) !print *, minval(fcst(:,:,1)),maxval(fcst) where(b(:,:,1)<0.5*spval .and. mdepth1500.0) b(:,:,1)=spval !if(pid==0) print *,"thkn: ", k,minval(b,mask=b1) call do_analysis_mgrid(var,varb(:,:,1),e(:,:,1)) call spmd_collect(work2d(:,:,1)) IF(PID==0) then !call smooth(work2d(:,:,1), nx, ny,0.,4) ! if(abs(maxval(work2d(:,:,1)))>100.0) then ! write(*,*) "thkn: ",maxval(abs(work2d(:,:,1))), maxloc(abs(work2d(:,:,1))) !where(abs(work2d(:,:,1))>100.0) work2d(:,:,1)=0.0 ! endif apin(:,:,k)=fpin(:,:,k)+work2d(:,:,1) ! ncfile=lin//"_test_pin.nc" ! call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),work2d(:,:,1),"pin","interface_depth","m",nx,ny,1,1) ENDIF !endif ! idx call spmd_wait() IF(PID==0) write(*,*) "....finsished t/s/rho/dp layer.... ",k enddo else if(pid==0) then write(*,*) "....no profile obs.... " assh=fssh endif endif !call spmd_wait() !call stop_spmd() !stop end subroutine subroutine do_sla_analysis() character(:),allocatable :: var,ncfile,fname integer(i4) :: k,m,fid,nb,i,j real(r4) :: mm,mb,sla_offset call read_prep_params() k=1 var="ssh" m=0 !call loadEns2d(ens,var,k,m) work2d(:,:,1)=0.0 fcst(:,:,1)=0.0 !if(pid==0) then ! fname="fcst.nc" ! call nciopn(fname,fid) ! call nciorv(fname,fid,"ssh",fcst(:,:,1)) ! call nciocl(fname,fid) !endif IF(PID==0) fcst(:,:,1)=assh call spmd_bcast_array(fcst(:,:,1),0) if(lsla) then fname=trim(tsis_obs_location)//"/tsis_obs_"//trim(mpfx)//"_"//cdtg//".nc" call nciopn(fname,fid) call nciorv(fname,fid,"ssh",b(:,:,1)) call nciocl(fname,fid) !!Alex ignore unusual big SSH values from AVISO (> 1.0m) ... where(b(:,:,1)>= 1.0) b(:,:,1) = spval call get_varb(mpfx,var,varb,k) e=0.04 mm=0. mb=0. nb=0 do j=1,ny do i=1,nx if(b(i,j,1)<0.5*spval .and. mdepth(i,j)0.1*spval) work2d(:,:,1)=spval ! assh=fcst(:,:,1)+work2d(:,:,1) ! where(fcst(:,:,1)>0.1*spval) assh=spval if (lglb) then !!Alex ncfile="sla_inc_"//trim(cdtg)//".nc" ncfile="sla_inc.nc" call ncfldij(ncfile,work2d(:,:,1),"sla_inc","analyzed increments","",nx,ny) else !ncfile="fssh.nc" !call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),fssh,"ssh","sm_ssh","",nx,ny,1,1) !!Alex ncfile="sla_inc_"//trim(cdtg)//".nc" ncfile="sla_inc.nc" call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),work2d(:,:,1),"sla_inc","analyzed increments","",nx,ny,1,1) endif write(*,*) "....finished sla analysis...." ENDIF else IF(PID==0) write(*,*) "....no obs for sla analysis...." endif call spmd_wait() end subroutine subroutine do_sss_analysis() character(:),allocatable :: var,ncfile,fname integer(i4) :: k,m,fid call read_sst_prep_params() k=1 var="sal" m=0 work2d(:,:,1)=0.0 fname=trim(tsis_obs_location)//"/tsis_obs_"//trim(mpfx)//"_"//cdtg//".nc" call nciopn(fname,fid) call nciorv(fname,fid,"sss",b(:,:,1)) call nciorv(fname,fid,"sss_err",e(:,:,1)) call nciocl(fname,fid) if(lsst) then call get_varb(mpfx,var,varb,k) var="sal" work2d(:,:,1)=0.0 fcst(:,:,1)=0.0 IF(PID==0) then where(mdepth==spval) fsss=spval call smooth(fsss,nx,ny,spval,4) fcst(:,:,1)=fsss endif call spmd_bcast_array(fcst(:,:,1),0) call do_gridded_mgrid(var,b(:,:,1),varb(:,:,1),e(:,:,1)) call spmd_collect(work2d(:,:,1)) call smooth(work2d(:,:,1), nx, ny,0.,4) IF(PID==0) then where(abs(work2d(:,:,1))>10.0) work2d(:,:,1)=0.0 asal(:,:,1)=fsal(:,:,1)+ work2d(:,:,1) !!Alex fsal(:,:,1)=fsal(:,:,1)+ work2d(:,:,1) if (lglb) then ncfile="sss_inc_"//trim(cdtg)//".nc" call ncfldij(ncfile,work2d(:,:,1),"sss_inc","analyzed increments","",nx,ny) else ncfile="sss_inc_"//trim(cdtg)//".nc" call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),work2d(:,:,1),"sss_inc","analyzed increments","",nx,ny,1,1) endif write(*,*) "....finished sss analysis...." ENDIF else IF(PID==0) write(*,*) "....no obs for sst analysis...." endif call spmd_wait() end subroutine subroutine do_sst_analysis() character(:),allocatable :: var,ncfile,fname integer(i4) :: k,m,fid call read_sst_prep_params() k=1 var="tem" m=0 work2d(:,:,1)=0.0 fname=trim(tsis_obs_location)//"/tsis_obs_"//trim(mpfx)//"_"//cdtg//".nc" call nciopn(fname,fid) call nciorv(fname,fid,"sst",b(:,:,1)) call nciorv(fname,fid,"sst_err",e(:,:,1)) call nciocl(fname,fid) if(lsst) then call get_varb(mpfx,var,varb,k) var="sst" work2d(:,:,1)=0.0 fcst(:,:,1)=0.0 IF(PID==0) then where(mdepth==spval) fsst=spval call smooth(fsst,nx,ny,spval,4) fcst(:,:,1)=fsst endif call spmd_bcast_array(fcst(:,:,1),0) call do_gridded_mgrid(var,b(:,:,1),varb(:,:,1),e(:,:,1)) call spmd_collect(work2d(:,:,1)) call smooth(work2d(:,:,1), nx, ny,0.,4) IF(PID==0) then where(abs(work2d(:,:,1))>10.0) work2d(:,:,1)=0.0 atem(:,:,1)=ftem(:,:,1)+ work2d(:,:,1) !!Alex ftem(:,:,1)=ftem(:,:,1)+ work2d(:,:,1) if (lglb) then !!Alex ncfile="sst_inc_"//trim(cdtg)//".nc" ncfile="sst_inc.nc" call ncfldij(ncfile,work2d(:,:,1),"sst_inc","analyzed increments","m",nx,ny) else !!Alex ncfile="sst_inc_"//trim(cdtg)//".nc" ncfile="sst_inc.nc" call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),work2d(:,:,1),"sst_inc","analyzed increments","m",nx,ny,1,1) endif write(*,*) "....finished sst analysis...." ENDIF else IF(PID==0) write(*,*) "....no obs for sst analysis...." endif call spmd_wait() end subroutine subroutine do_adjust_state_profile() implicit none real(r4) :: tsden(nz) integer(i4) :: kiso_top,kiso_bot,i,j,k,ii,jj,nbad character(:),allocatable :: ncfile IF(pid==0 .and. lprofile) then do j=1,ny do i=1,nx if(mdepth(i,j)<2.00**99) then apin(i,j,nz+1)=mdepth(i,j) do k=1,nz athk(i,j,k)=(apin(i,j,k+1)-apin(i,j,k))*9806. enddo kiso_top=1 kiso_bot=nz ! compute analyzed density from analyzed T & S do k=1,nz tsden(k)=sig(atem(i,j,k),asal(i,j,k),sigver) enddo aden(i,j,:)=tsden ! clean up any negative thickness 1st pass do k = 1, nz-1 athk(i,j,k+1) =athk(i,j,k+1)+min(0.0,athk(i,j,k)) athk(i,j,k) =max(athk(i,j,k),0.0) end do ! clean up any negative thicknes 2nd pass do k = nz, 2, -1 athk(i,j,k-1) = athk(i,j,k-1)+min(0.0,athk(i,j,k)) athk(i,j,k) = max(athk(i,j,k),0.0) end do ! end post procesing endif enddo enddo !print *, nobs !do i=1,nobs !Write(*,*) "profile No: ", i !Write(*,*) "***********************************" !do k=1,nz !if(profile_obs(1,k,i)%id==1) then !ii=profile_obs(1,k,i)%gridi !jj=profile_obs(1,k,i)%gridj !profile_obs(1,k,i)%res=profile_obs(1,k,i)%val-ftem(ii,jj,k) !profile_obs(2,k,i)%res=profile_obs(2,k,i)%val-fsal(ii,jj,k) !profile_obs(4,k,i)%res=profile_obs(4,k,i)%val-fpin(ii,jj,k) !write(*,'(9F12.3)') mdepth(ii,jj),profile_obs(1,k,i)%lon,profile_obs(1,k,i)%lat,profile_obs(1,k,i)%inov,profile_obs(1,k,i)%res,profile_obs(2,k,i)%inov,profile_obs(2,k,i)%res,profile_obs(4,k,i)%inov,profile_obs(4,k,i)%res !endif !enddo !enddo !ncfile="fssh.nc" !call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),fssh,"fssh","forecast ssh","m",nx,ny,1,1) !call ncfldij(ncfile,fssh,"fssh","forecast ssh","m",nx,ny) !!Alex call getssh(count(1),count(2),count(3),kapref,pref,thbase,thref,imask,asal,atem,athk,aden-thbase,fpba,fpsikk,fthkk,fmgp,assh) call getssh(count(1),count(2),count(3),kapref,pref,thbase,thref,imask,asal,atem,athk,aden-thbase,fpba,fpsikk,fthkk,amgp,assh) !!Alex ncfile="issh_"//trim(cdtg)//".nc" ncfile="issh.nc" !call ncfldij(ncfile,assh,"issh","analyzed ssh","m",nx,ny) call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),assh-fssh,"issh","intermediate ssh","m",nx,ny,1,1) ists=1.0 nbad=0 do j=1,ny do i=1,nx if(abs(assh(i,j)-fssh(i,j))>1.0 .and. mdepth(i,j)<2.00**100) then nbad=nbad+1 !write(*,*) "Location: ", i,j,fssh(i,j),assh(i,j),mdepth(i,j) do k=1,nz !write(*,'(I4,2x,6F15.4)') k,ftem(i,j,k),atem(i,j,k),fsal(i,j,k),asal(i,j,k),fthk(i,j,k)/9806.,athk(i,j,k)/9806. atem(i,j,k)=ftem(i,j,k) asal(i,j,k)=fsal(i,j,k) athk(i,j,k)=fthk(i,j,k) enddo !stop endif enddo enddo write(*,*) "No of bad locations: ", nbad do j=1,ny do i=1,nx if(abs(assh(i,j)-fssh(i,j))>0.02 .and. mdepth(i,j)<2.00**100) then ists(i,j)=0.0 endif enddo enddo !fathk=fthk !assh=issh else IF(PID==0) write(*,*) "....no profile obs to adjust state...." ists=1.0 endif call spmd_wait() end subroutine subroutine do_adjust_state() IF(pid==0) then call adjustStateLilo() !call do_clean_dp() ENDIF end subroutine subroutine do_diagnostics() implicit none character(:),allocatable :: ncfile,incupFile integer(i4) :: iyear,iyday,ihour character(4) :: cyear character(3) :: cday character(2) :: chour integer(i4) :: i,j,k,sver IF(pid==0) then call forday(stime(1),iyear,iyday,ihour) write(cyear(1:4),'(i4.4)') iyear write(cday(1:3),'(i3.3)') iyday write(chour(1:2),'(i2.2)') ihour !if(fcst(:,:,1)_file_out) then ! incupFile="archv."//cyear//"_"//cday//"_"//chour ! call writearchv(incupFile,nx,ny,nz,stime(1),thbase,thflag,sver,mlayer,mdepth,fssh,fmld,fuba,fvba,fuvl,fvvl,fthk,ftem,fsal) !endif incupFile="incup/incupd_out" ! get geostrophic correction !!Alex !call getssh(count(1),count(2),count(3),kapref,pref,thbase,thref,imask,asal,atem,fathk,aden-thbase,fpba,fpsikk,fthkk,amgp,assh) ! need dmgp ! amgp=amgp-fmgp if(pid==0) print *,"amgp: ", minval(amgp),maxval(amgp) ! call geocorr(start,count,mlat,mlon,amgp,athk,auvl,avvl) auvl=fuvl avvl=fvvl ! call geocorr(start,count,mlat,mlon,amgp,athk,auvl,avvl) ! ncfile="fssh_"//cyear//"_"//cday//"_"//chour//".nc" ! call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),fssh,"fssh","forecast_ssh","",nx,ny,1,1) ! ncfile="assh_"//cyear//"_"//cday//"_"//chour//".nc" ! call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),assh,"assh","final_analyzed_ssh","",nx,ny,1,1) ncfile="fssh.nc" call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),fssh,"fssh","forecast_ssh","",nx,ny,1,1) ncfile="assh.nc" call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),assh,"assh","final_analyzed_ssh","",nx,ny,1,1) ! ncfile="fmgp_"//cyear//"_"//cday//"_"//chour//".nc" ! call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),fmgp(:,:,:),"fmgp","forecast_mont","",nx,ny,nz,1) ! ncfile="amgp_"//cyear//"_"//cday//"_"//chour//".nc" ! call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),amgp(:,:,:),"amgp","final_analyzed_mont","",nx,ny,nz,1) ! ! ncfile="fuvl_"//cyear//"_"//cday//"_"//chour//".nc" ! call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),fuvl(:,:,:),"fuvl","forecast_uvl1","",nx,ny,nz,1) ! ncfile="auvl_"//cyear//"_"//cday//"_"//chour//".nc" ! call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),auvl(:,:,:),"auvl","final_analyzed_uvl1","",nx,ny,nz,1) ! ! ! ncfile="uvl_inc_"//cyear//"_"//cday//"_"//chour//".nc" ! call ncfldio(ncfile,mlon(:,1),mlat(1,:),mlayer,stime(1),auvl(:,:,:)-fuvl(:,:,:),"uvl_inc","inc_uvl1","",nx,ny,nz,1) incupFile=anlFileName//cyear//"_"//cday//"_"//chour call writearchv(incupFile,nx,ny,nz,stime(1),thbase,thflag,sigver,mlayer,mdepth,assh,fmld,fuba,fvba,auvl,avvl,fathk,atem,asal) !! changes to write out inc file ! if(pid==0) print *,"auvl: ", minval(auvl),maxval(auvl) ! if(pid==0) print *,"fuvl: ", minval(fuvl),maxval(fuvl) ! fathk=fathk-fthk ! atem=atem-ftem ! asal=asal-fsal ! auvl=auvl-fuvl ! avvl=avvl-fvvl ! auba=0.0 ! avba=0.0 ! if(pid==0) print *,"auvl: ", minval(auvl),maxval(auvl) ! fathk=fathk-fthk ! atem=atem-ftem ! asal=asal-fsal ! fuvl=0.0 ! fvvl=0.0 ! fuba=0.0 ! fvba=0.0 ! incupFile=anlFileName//cyear//"_"//cday//"_"//chour ! IF(PID==0) Write(*,*) "....writing incup file.... ", incupFile !!Alex call writearchv(incupFile,nx,ny,nz,stime(1),thbase,thflag,sigver,mlayer,mdepth,assh,fmld,fuba,fvba,fuvl,fvvl,fathk,atem,asal) ! call writearchv(incupFile,nx,ny,nz,stime(1),thbase,thflag,sigver,mlayer,mdepth,assh,fmld,auba,avba,auvl,avvl,fathk,atem,asal) !if(lglb) call tops_glb_inc_r2c(incupFile) endif end subroutine subroutine set_analysis_date(cdtg) use mkinds implicit none character(len=10) :: buffer integer(i4) :: iargc integer(i4) :: n character(*) :: cdtg ! check command line arguments and get date n=iargc() if (n == 1) then call getarg(1,buffer) read (buffer,*) cdtg IF(PID==0) Write(*,*) "....starting T-SIS analysis for.... ", cdtg else call date_and_time(cdtg) IF(PID==0) Write(*,*) "....starting T-SIS analysis for.... ", cdtg endif allocate(stime(1)) call CDATE2WNDAY(stime(1),cdtg) !stime(1)=stime(1)-0.25 !!Alex add comment on 0.25 end subroutine set_analysis_date subroutine Finalize() IF(PID==0) Write(*,*) "....finished T-SIS analysis for.... ", cdtg call stop_spmd() End Subroutine subroutine set_model_info() implicit none character(len=20) :: model,fcst_file,anl_file character(len=5) :: pfx NAMELIST/model_info/model,sigver,lglb,fcst_file,anl_file,fcst_file_out,pfx ! read analysis parameters OPEN(21,FILE='tsis.nlist') READ(21,NML=model_info) CLOSE(21) FCmodel=trim(model) FCFileName=trim(fcst_file) anlFileName=trim(anl_file) mpfx=trim(pfx) end subroutine end module