[cig-commits] r15919 - in seismo/3D/ADJOINT_TOMO/flexwin: . ttimes_mod

[liuqy at geodynamics.org]

Author: liuqy
Date: 2009-11-03 09:01:49 -0800 (Tue, 03 Nov 2009)
New Revision: 15919

Modified:
   seismo/3D/ADJOINT_TOMO/flexwin/travel_times.f90
   seismo/3D/ADJOINT_TOMO/flexwin/ttimes_mod/libtau.f
Log:
No longer need to have iasp91.hed and iasp91.tbl in the run directory, as long as $IASPMODEL is set properly, and ${IASPMODEL}.hed and ${IASPMODEL}.tbl exist.

add implicit none to travel_time.f90



Modified: seismo/3D/ADJOINT_TOMO/flexwin/travel_times.f90
===================================================================
--- seismo/3D/ADJOINT_TOMO/flexwin/travel_times.f90	2009-11-02 19:45:52 UTC (rev 15918)
+++ seismo/3D/ADJOINT_TOMO/flexwin/travel_times.f90	2009-11-03 17:01:49 UTC (rev 15919)
@@ -7,6 +7,7 @@
 
   subroutine ttimes(dist_deg,depth,nphases,names,times)
 
+  implicit none
   integer, parameter :: MAX_PHASES=60
 
   real, intent(in) :: dist_deg, depth
@@ -21,7 +22,8 @@
   real usrc(2)
   real, dimension(MAX_PHASES) :: dtdd,dtdh,dddp
   real, dimension(MAX_PHASES) :: times_sngl
-  character*20 modnam
+  character*262 modnam
+  character*256 iaspmod
 
 
   ! ask for all phases
@@ -29,7 +31,12 @@
   prnt(1)=.false.
   prnt(2)=.false.
   prnt(3)=.false.
-  modnam='iasp91'
+  call getenv('IASPMODEL', iaspmod)
+  if (trim(iaspmod) == '') then
+    modnam='iasp91'
+  else
+    modnam=iaspmod
+  endif
   call tabin(1,modnam)
   call brnset(1,phlst,prnt)
   call depset(depth,usrc)

Modified: seismo/3D/ADJOINT_TOMO/flexwin/ttimes_mod/libtau.f
===================================================================
--- seismo/3D/ADJOINT_TOMO/flexwin/ttimes_mod/libtau.f	2009-11-02 19:45:52 UTC (rev 15918)
+++ seismo/3D/ADJOINT_TOMO/flexwin/ttimes_mod/libtau.f	2009-11-03 17:01:49 UTC (rev 15919)
@@ -13,7 +13,6 @@
       save
       logical log
       character*(*) ia,ib
-      character*25 ic
 c
 c     if(iargc(i).lt.n) go to 1
       if(iargc().lt.n) go to 1
@@ -27,9 +26,7 @@
 c
  2    nb=index(ib,' ')-1
       if(nb.le.0) nb=len(ib)
-      ic=ib(1:nb)//'.hed'
-c	ic=ic//'.hed'
-      call assign(lu,mode,ic)
+      call assign(lu,mode,ib(1:nb)//'.hed')
       return
       end
       subroutine assign(lu,mode,ia)
@@ -1485,7 +1482,7 @@
       character*(*) modnam
 c     logical log
       character*8 phcd,phdif(6)
-      character*25 modnam2
+c      character*25 modnam2
       double precision pm,zm,us,pt,tau,xlim,xbrn,dbrn,zs,pk,pu,pux,tauu,
      1 xu,px,xt,taut,coef,tauc,xc,tcoef,tp
 c
@@ -1522,10 +1519,7 @@
 c
       nb=index(modnam,' ')-1
       if(nb.le.0) nb=len(modnam)
-      modnam2=modnam(1:nb)//'.tbl'
-c     modnam2=modnam2//'.tbl'
-c     call dasign(nin,-1,modnam(1:nb)//'.tbl',nasgr)
-      call dasign(nin,-1,modnam2,nasgr)
+      call dasign(nin,-1,modnam(1:nb)//'.tbl',nasgr)
 c
       do 11 nph=1,2
  11   pu(ku(nph)+1,nph)=pm(1,nph)