[cig-commits] r22387 - seismo/3D/SPECFEM3D_GLOBE/trunk/src/meshfem3D

[elliott.sales.de.andrade at geodynamics.org]

Author: elliott.sales.de.andrade
Date: 2013-06-20 15:03:13 -0700 (Thu, 20 Jun 2013)
New Revision: 22387

Modified:
   seismo/3D/SPECFEM3D_GLOBE/trunk/src/meshfem3D/model_aniso_mantle.f90
Log:
Remove gotos and fix indenting in lecmod function.

Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/src/meshfem3D/model_aniso_mantle.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/meshfem3D/model_aniso_mantle.f90	2013-06-20 22:03:01 UTC (rev 22386)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/meshfem3D/model_aniso_mantle.f90	2013-06-20 22:03:13 UTC (rev 22387)
@@ -544,7 +544,7 @@
 ! output: array pari(ipar, nlayer): rho, A, L, xi-1, phi-1, eta-1
 
   integer i,j,k,ip,ifanis,idum1,idum2,idum3,nlayer,nout,neff,&
-          nband,nri,minlay,moho,kiti
+          nband,nri,minlay,moho,kiti,ier
   double precision pari(14,47),qkappa(47),qshear(47),par(6,47)
   double precision epa(14,47),ra(47),dcori(47),ri(47)
   double precision corpar(21,47)
@@ -552,59 +552,83 @@
   character(len=80) null
   character(len=150) Adrem119
 
-     ifanis = 1
-     nri = 47
+  ifanis = 1
+  nri = 47
 
-     call get_value_string(Adrem119, 'model.Adrem119', 'DATA/Montagner_model/Adrem119')
-     open(unit=13,file=Adrem119,status='old',action='read')
-     read(13,*,end = 77) nlayer,minlay,moho,nout,neff,nband,kiti,null
+  call get_value_string(Adrem119, 'model.Adrem119', 'DATA/Montagner_model/Adrem119')
+  open(unit=13,file=Adrem119,status='old',action='read')
+  read(13,*,iostat=ier) nlayer,minlay,moho,nout,neff,nband,kiti,null
+  if (ier /= 0) then
+    close(13)
+    return
+  endif
 
-     if(kiti == 0) read(13,"(20a4)",end = 77) idum1
-     read(13,"(20a4)",end = 77) idum2
-     read(13,"(20a4)",end = 77) idum3
+  if (kiti == 0) then
+    read(13,"(20a4)",iostat=ier) idum1
+    if (ier /= 0) then
+      close(13)
+      return
+    endif
+  endif
+  read(13,"(20a4)",iostat=ier) idum2
+  if (ier /= 0) then
+    close(13)
+    return
+  endif
+  read(13,"(20a4)",iostat=ier) idum3
+  if (ier /= 0) then
+    close(13)
+    return
+  endif
 
-     do i = 1,nlayer
-       read(13,"(4x,f11.1,8d12.5)",end = 77) ra(i),(par(k,i),k = 1,6),qshear(i),qkappa(i)
-     enddo
+  do i = 1,nlayer
+    read(13,"(4x,f11.1,8d12.5)",iostat=ier) ra(i),(par(k,i),k = 1,6),qshear(i),qkappa(i)
+    if (ier /= 0) then
+      close(13)
+      return
+    endif
+  enddo
 
-     do i = 1,nlayer
-       ri(i) = 0.001*ra(i)
-     enddo
+  do i = 1,nlayer
+    ri(i) = 0.001*ra(i)
+  enddo
 
-     do i = 1,nlayer
-       rho = par(1,i)
-       pari(1,i) = rho
-!    A : pari(2,i)
-       pari(2,i) = rho*(par(2,i)**2)
-       aa = pari(2,i)
-!    L : pari(3,i)
-       pari(3,i) = rho*(par(3,i)**2)
-       al = pari(3,i)
-!    Xi : pari(4,i)= (N-L)/L
-       an = al*par(4,i)
-       pari(4,i) = 0.
-       pari(4,i) = par(4,i) - 1.
-!    Phi : pari(5,i)=(a-c)/a
-       pari(5,i) = - par(5,i) + 1.
-       ac = par(5,i)*aa
-!    f : pari(4,i)
-       af = par(6,i)*(aa - 2.*al)
-       pari(6,i) = par(6,i)
-       do ip = 7,14
-         pari(ip,i) = 0.
-       enddo
-       vsv = 0.
-       vsh = 0.
-       if(al < 0.0001 .or. an < 0.0001) goto 12
-       vsv = dsqrt(al/rho)
-       vsh = dsqrt(an/rho)
- 12    vpv = dsqrt(ac/rho)
-       vph = dsqrt(aa/rho)
-     enddo
+  do i = 1,nlayer
+    rho = par(1,i)
+    pari(1,i) = rho
+! A : pari(2,i)
+    pari(2,i) = rho*(par(2,i)**2)
+    aa = pari(2,i)
+! L : pari(3,i)
+    pari(3,i) = rho*(par(3,i)**2)
+    al = pari(3,i)
+! Xi : pari(4,i)= (N-L)/L
+    an = al*par(4,i)
+    pari(4,i) = 0.
+    pari(4,i) = par(4,i) - 1.
+! Phi : pari(5,i)=(a-c)/a
+    pari(5,i) = - par(5,i) + 1.
+    ac = par(5,i)*aa
+! f : pari(4,i)
+    af = par(6,i)*(aa - 2.*al)
+    pari(6,i) = par(6,i)
+    do ip = 7,14
+      pari(ip,i) = 0.
+    enddo
+    vsv = 0.
+    vsh = 0.
+    if (al >= 0.0001 .and. an >= 0.0001) then
+      vsv = dsqrt(al/rho)
+      vsh = dsqrt(an/rho)
+    endif
+    vpv = dsqrt(ac/rho)
+    vph = dsqrt(aa/rho)
+  enddo
 
   red = 1.
   do i = 1,nlayer
-    read(13,"(15x,6e12.5,f11.1)",end = 77) (epa(j,i),j = 1,6),dcori(i)
+    read(13,"(15x,6e12.5,f11.1)",iostat=ier) (epa(j,i),j = 1,6),dcori(i)
+    if (ier /= 0) exit
     epa(7,i) = epa(2,i)
     epa(8,i) = epa(2,i)
     epa(9,i) = epa(3,i)
@@ -620,11 +644,11 @@
       epa(j,i) = red*epa(j,i)
     enddo
 
-    read(13,"(21f7.3)",end = 77) (corpar(j,i),j = 1,21)
-
+    read(13,"(21f7.3)",iostat=ier) (corpar(j,i),j = 1,21)
+    if (ier /= 0) exit
   enddo
 
-77 close(13)
+  close(13)
 
   end subroutine lecmod