[cig-commits] r18546 - seismo/3D/FAULT_SOURCE/branches/new_fault_db/src

[ampuero at geodynamics.org]

Author: ampuero
Date: 2011-06-06 09:51:45 -0700 (Mon, 06 Jun 2011)
New Revision: 18546

Modified:
   seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/create_regions_mesh.f90
   seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_object.f90
Log:
fixed ANY_FAULT* flag handling

Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/create_regions_mesh.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/create_regions_mesh.f90	2011-06-05 03:29:04 UTC (rev 18545)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/create_regions_mesh.f90	2011-06-06 16:51:45 UTC (rev 18546)
@@ -161,7 +161,7 @@
 
 ! initializes arrays
   call sync_all()
-  if( myrank == 0) then
+  if (myrank == 0) then
     write(IMAIN,*)
     write(IMAIN,*) '  ...allocating arrays '
   endif
@@ -173,57 +173,48 @@
   call fault_read_input(prname,NDIM)
 
   call sync_all()
-  if( myrank == 0) then
-    write(IMAIN,*) '  ...setting up jacobian '
-  endif
-
+  if (myrank == 0) write(IMAIN,*) '  ...setting up jacobian '
   if (ANY_FAULT_IN_THIS_PROC) then
    ! compute jacobians with fault open and *store needed for ibool.
     call crm_ext_setup_jacobian(myrank, &
                          xstore,ystore,zstore,nspec, &
                          nodes_coords_open, nnodes_coords_open,&
                          elmnts_ext_mesh,nelmnts_ext_mesh)
-   ! create ibool with faults open
-    call sync_all()
-    if( myrank == 0) then
-      write(IMAIN,*) '  ...indexing global points'
-    endif
-    call crm_ext_setup_indexing(ibool, &
-                       xstore,ystore,zstore,nspec,nglob,npointot, &
-                       nnodes_coords_open,nodes_coords_open,myrank)
-
-   ! recalculate *store with faults closed 
-    call sync_all()
-    if( myrank == 0) then
-      write(IMAIN,*) '  ...setting up jacobian '
-    endif
+  else ! with no fault
     call crm_ext_setup_jacobian(myrank, &
-                           xstore,ystore,zstore,nspec, &
-                           nodes_coords_ext_mesh,nnodes_ext_mesh,&
-                           elmnts_ext_mesh,nelmnts_ext_mesh)
-
-   ! at this point (xyz)store_dummy are still open
-
- ! with no fault
-  else 
-    call crm_ext_setup_jacobian(myrank, &
                         xstore,ystore,zstore,nspec, &
                         nodes_coords_ext_mesh,nnodes_ext_mesh,&
                         elmnts_ext_mesh,nelmnts_ext_mesh)
+  endif
 
-    call sync_all()
-    if( myrank == 0) then
-      write(IMAIN,*) '  ...indexing global points'
-    endif
+ ! create ibool with faults open
+  call sync_all()
+  if (myrank == 0) write(IMAIN,*) '  ...indexing global points'
+  if (ANY_FAULT_IN_THIS_PROC) then
     call crm_ext_setup_indexing(ibool, &
+                       xstore,ystore,zstore,nspec,nglob,npointot, &
+                       nnodes_coords_open,nodes_coords_open,myrank)
+  else ! with no fault
+    call crm_ext_setup_indexing(ibool, &
                       xstore,ystore,zstore,nspec,nglob,npointot, &
                       nnodes_ext_mesh,nodes_coords_ext_mesh,myrank)
   end if
 
-  call fault_setup (ibool,nnodes_ext_mesh,nodes_coords_ext_mesh, &
+  if (ANY_FAULT) then
+   ! recalculate *store with faults closed 
+    call sync_all()
+    if (myrank == 0) write(IMAIN,*) '  ... resetting up jacobian in fault domains'
+    if (ANY_FAULT_IN_THIS_PROC) call crm_ext_setup_jacobian(myrank, &
+                           xstore,ystore,zstore,nspec, &
+                           nodes_coords_ext_mesh,nnodes_ext_mesh,&
+                           elmnts_ext_mesh,nelmnts_ext_mesh)
+   ! at this point (xyz)store_dummy are still open
+    call fault_setup (ibool,nnodes_ext_mesh,nodes_coords_ext_mesh, &
                     xstore,ystore,zstore,nspec,nglob,myrank)
- ! this closes (xyz)store_dummy
+   ! this closes (xyz)store_dummy
+  endif
 
+
 ! sets up MPI interfaces between partitions
   call sync_all()
   if( myrank == 0) then

Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_object.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_object.f90	2011-06-05 03:29:04 UTC (rev 18545)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_object.f90	2011-06-06 16:51:45 UTC (rev 18546)
@@ -53,6 +53,7 @@
   double precision, allocatable, save :: nodes_coords_open(:,:)
   integer, save :: nnodes_coords_open
   logical, save :: ANY_FAULT_IN_THIS_PROC = .false.
+  logical, save :: ANY_FAULT = .false.
   
   ! corners indices of reference cube faces
   integer,dimension(3,4),parameter :: iface1_corner_ijk = &
@@ -73,7 +74,7 @@
                  iface5_corner_ijk,iface6_corner_ijk /),(/3,4,6/))   ! all faces
 
   public :: fault_read_input, fault_setup, fault_save_arrays_test, fault_save_arrays, &
-            nodes_coords_open, nnodes_coords_open, ANY_FAULT_IN_THIS_PROC
+            nodes_coords_open, nnodes_coords_open, ANY_FAULT_IN_THIS_PROC, ANY_FAULT
 
 contains
 
@@ -99,7 +100,11 @@
   end if
   close(IIN)
 
-  if (nb>0) allocate(fault_db(nb))
+  ANY_FAULT = (nb>0)
+
+  if (.not. ANY_FAULT)  return
+
+  allocate(fault_db(nb))
   do i=1,nb
     fault_db(i)%eta = eta
   enddo 
@@ -533,7 +538,7 @@
   integer :: nbfaults,iflt,ier
   character(len=256) :: filename 
 
-  if (.not.allocated(fault_db)) return
+  if (.not.ANY_FAULT) return
 
 ! saves mesh file proc***_fault_db.txt
   filename = prname(1:len_trim(prname))//'fault_db.txt'
@@ -606,7 +611,7 @@
   integer :: nbfaults,iflt,ier
   character(len=256) :: filename
 
-  if (.not.allocated(fault_db)) return
+  if (.not.ANY_FAULT) return
 
 ! saves mesh file proc***_Kelvin_voigt_eta.bin
   if (allocated(Kelvin_Voigt_eta)) then