[cig-commits] r3885 - in long/2D/plasti/trunk: . SRC

[walter at geodynamics.org]

Author: walter
Date: 2006-06-26 10:26:58 -0700 (Mon, 26 Jun 2006)
New Revision: 3885

Modified:
   long/2D/plasti/trunk/Makefile
   long/2D/plasti/trunk/SRC/meshg_oly.f
   long/2D/plasti/trunk/SRC/thermal_oly.f
Log:
Fix an uninitialized variable bug, plus fixes to make g95 happy.


Modified: long/2D/plasti/trunk/Makefile
===================================================================
--- long/2D/plasti/trunk/Makefile	2006-06-26 17:11:16 UTC (rev 3884)
+++ long/2D/plasti/trunk/Makefile	2006-06-26 17:26:58 UTC (rev 3885)
@@ -1,11 +1,15 @@
 
 ## compilers
 FORT  = gfortran
-CC = gcc
-## libraries
-LIBS2 = -llapack -lblas
 F90FLAGS = -O3
 
+# g95-specific flags
+#FORT  = g95
+#F90FLAGS = -O3 -fsloppy-char
+
+## libraries
+LIBS = -llapack -lblas
+
 all: plasti_oly meshg_oly
 
 #####
@@ -15,7 +19,7 @@
 PLAS_OBJS = SRC/plasti_oly.o SRC/thermal_oly.o
 ## Link all files into main program
 plasti_oly: $(PLAS_OBJS)
-	$(FORT) $(PLAS_OBJS) -o plasti_oly -llapack -lblas
+	$(FORT) $(LINKFLAGS) $(PLAS_OBJS) -o plasti_oly $(LIBS)
 ## compile object files
 SRC/plasti_oly.o: SRC/plasti_oly.f 
 	$(FORT) $(F90FLAGS) -c SRC/plasti_oly.f -o SRC/plasti_oly.o
@@ -33,7 +37,7 @@
 MESH_OBJS = SRC/meshg_oly.o SRC/erfc.o
 ## Link files into main program
 meshg_oly: $(MESH_OBJS)
-	$(FORT) $(MESH_OBJS) -o meshg_oly
+	$(FORT) $(LINKFLAGS) $(MESH_OBJS) -o meshg_oly
 ## compile object files
 SRC/meshg_oly.o: SRC/meshg_oly.f
 	$(FORT) $(F90FLAGS) -c -o SRC/meshg_oly.o SRC/meshg_oly.f

Modified: long/2D/plasti/trunk/SRC/meshg_oly.f
===================================================================
--- long/2D/plasti/trunk/SRC/meshg_oly.f	2006-06-26 17:11:16 UTC (rev 3884)
+++ long/2D/plasti/trunk/SRC/meshg_oly.f	2006-06-26 17:26:58 UTC (rev 3885)
@@ -154,9 +154,10 @@
       allocate(mecht_nodes(ncol),plithb_nodes(nplbase),
      *plitht_nodes(npltop),mechb_nodes(ncol),
      *rlithb_nodes(ncol-nsing))
+
 c initialize indicies for the above arrays
 c     top of mech model
-      imtnodes=0
+      imtnode=0
 c     base of pro lith      
       iplbnode=0
 c     top of pro lith
@@ -1001,9 +1002,15 @@
 c calculate deflection of semi-infinite plates using 
 c	the end cond forces and subduction load/moment
 c     	plate 1
-      	call deflect2(np1,plam1,fk,xp1,0.0,0.0,amom1,ashear1,yp1)
+
+        adummy1=0.0
+        adummy2=0.0
+
+      	call deflect2(np1,plam1,fk,xp1,adummy1,adummy2,amom1,ashear1,yp1)
+C       	call deflect2(np1,plam1,fk,xp1,0.0,0.0,amom1,ashear1,yp1)
 c     	plate 2
-      	call deflect2(np2,plam2,fk,xp2,0.0,0.0,amom2,ashear2,yp2)
+      	call deflect2(np2,plam2,fk,xp2,adummy1,adummy2,amom2,ashear2,yp2)
+C       	call deflect2(np2,plam2,fk,xp2,0.0,0.0,amom2,ashear2,yp2)
 c calculate the coupling load
       	ido_again=1
       	jcount=0
@@ -1077,9 +1084,14 @@
 c calculate deflection of semi-infinite plates using 
 c	the end cond forces and subduction load/moment
 c     plate 1
+
+      adummy1=0.0
+      adummy2=0.0
+
       call deflect2(np1,plam1,fk,xp1,sload,smomen,amom1,ashear1,yp1)
 c     plate 2
-      call deflect2(np2,plam2,fk,xp2,0.0,0.0,amom2,ashear2,yp2)
+      call deflect2(np2,plam2,fk,xp2,adummy1,adummy2,amom2,ashear2,yp2)
+C       call deflect2(np2,plam2,fk,xp2,0.0,0.0,amom2,ashear2,yp2)
 c      call profdump(xbase,yp1,yp2,np1,np2,nsing,npad)
 c      stop
 c calculate the coupling load and coupled position of plates
@@ -2821,7 +2833,7 @@
       print*,' Y pos of coupling point relative to sea level (km)'
      *,(-yp2(1)-yshift-wref)/1000.0
 
-      close(9);close(2);close(3);close(4);close(7);close(8)
+      close(2);close(3);close(4);close(7);close(8);close(9)
       close(10);close(11);close(12)
   113 format(4e16.8)
       end

Modified: long/2D/plasti/trunk/SRC/thermal_oly.f
===================================================================
--- long/2D/plasti/trunk/SRC/thermal_oly.f	2006-06-26 17:11:16 UTC (rev 3884)
+++ long/2D/plasti/trunk/SRC/thermal_oly.f	2006-06-26 17:26:58 UTC (rev 3885)
@@ -95,14 +95,14 @@
       if(info.ne.0) then
 	  	print*,'#####  ERROR IN FACTORIZATION, THERMAL DGBTRF'
 	  	print*,'info from dgbtrf',info
-       	call outputt(nn,ne,rhst,itst,nout,nrow,ncol,ioutpt)
+       	call outputt(nn,ne,itst,nout,nrow,ncol,ioutpt)
 	  	stop
 	  endif
 	  call dgbtrs('N',nn,lbw,lbw,1,a,lda,ipt,rhst,nn,info)
 	  if(info.ne.0) then
 	  	print*,'#####  ERROR IN FACTORIZATION, THERMAL DGBTRS'
 	  	print*,'info from dgbtrs',info
-	  	call outputt(nn,ne,rhst,itst,nout,nrow,ncol,ioutpt)
+	  	call outputt(nn,ne,itst,nout,nrow,ncol,ioutpt)
 	  	stop
 	  endif