p_oldtonewobs.F90 1.3 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071
  1. program oldtonewobs
  2. use mod_measurement_oldnew
  3. implicit none
  4. type (measurement_old) :: oldobs
  5. type (measurement_new) :: newobs
  6. integer :: reclold,reclnew
  7. integer :: iobs
  8. integer :: iosin, iosout
  9. logical :: ex
  10. ! copy old obs
  11. inquire(exist=ex,file='observations.uf')
  12. if (ex) then
  13. call system("cp observations.uf old_observations.uf")
  14. else
  15. print *,'observations.uf does not exist'
  16. call exit(1)
  17. end if
  18. ! Open old and new obs files
  19. inquire(iolength=reclold) oldobs
  20. inquire(iolength=reclnew) newobs
  21. open(10, file='old_observations.uf',status='old',recl=reclold,access='direct')
  22. open(11, file='new_observations.uf',status='replace',recl=reclnew,access='direct')
  23. iosin=0
  24. iosout=0
  25. iobs=1
  26. do while (iosin==0 .and. iosout==0)
  27. read(10,rec=iobs,iostat=iosin) oldobs
  28. if (iosin==0) then
  29. call oldtonew(oldobs,newobs)
  30. write(11,rec=iobs,iostat=iosout) newobs
  31. !print *,newobs%ipiv,newobs%jpiv
  32. iobs=iobs+1
  33. if (iosout/=0) then
  34. print *,'Error when writing to new obs'
  35. print *,'(oldtonewobs)'
  36. call exit(1)
  37. end if
  38. end if
  39. end do
  40. close(10)
  41. close(11)
  42. print *,'Processed ',iobs-1,' observations'
  43. end program oldtonewobs