[cig-commits] r3836 - short/3D/lithomop/trunk/lithomop3d/liblithomop3d

[willic3 at geodynamics.org]

Author: willic3
Date: 2006-06-21 10:14:55 -0700 (Wed, 21 Jun 2006)
New Revision: 3836

Modified:
   short/3D/lithomop/trunk/lithomop3d/liblithomop3d/write_ucd_header.F
Log:
Fixed problem where field units were not output for ascii UCD files.



Modified: short/3D/lithomop/trunk/lithomop3d/liblithomop3d/write_ucd_header.F
===================================================================
--- short/3D/lithomop/trunk/lithomop3d/liblithomop3d/write_ucd_header.F	2006-06-21 16:15:37 UTC (rev 3835)
+++ short/3D/lithomop/trunk/lithomop3d/liblithomop3d/write_ucd_header.F	2006-06-21 17:14:55 UTC (rev 3836)
@@ -55,11 +55,18 @@
       character stress*6,strain*4,strate*9
       data stress,strain,strate/"Pascal","None","1/seconds"/
 c
+c...  external functions
+c
+      integer nchar
+      external nchar
+c
 c...  local variables
 c
       integer i,ibyte,indl,indu
+      integer il
       integer iout(3*nstatesmax)
       character nlabels*1024,nunits*1024
+      character slabel*100
 c
 c...  included variable definitions
 c
@@ -73,7 +80,15 @@
         write(kucd,"(100i5)") nstatestot,(iout(i),i=1,nstatestot)
 c
         do i=1,nstatestot
-          write(kucd,"(a11)") labels(istatoutc(i))
+          il=nchar(labels(istatoutc(i)))
+          if(istatoutc(i).le.nstatesmax) then
+            slabel=labels(istatoutc(i))(1:il)//","//stress
+          else if(istatoutc(i).le.2*nstatesmax) then
+            slabel=labels(istatoutc(i))(1:il)//","//strain
+          else if(istatoutc(i).le.3*nstatesmax) then
+            slabel=labels(istatoutc(i))(1:il)//","//strate
+          end if
+          write(kucd,"(a100)") slabel
         end do
       else if(iucd.eq.itwo) then
         indl=ione