Program Thai Census Data 1980
*     This program reads the Standard Data and outputs the Merged Data
*     merging Mother and Child & Husband and Wife
      
      
*     Declare Real and Integers for programs
      
      integer f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12,f13
      logical p1,q1,p2,q2
      character*97 nxt, old
      character*10 lv
      character xi(30)*200
      character ka*8, ka2*16
      integer th, tn, x, y, u, s, m, n, o, p, q, w, pp,qq,qqq,qqqq
      integer th1, th2, thc1, thc2, thc3, thc4, thc5, thc6
      integer rl, sx, ag, mr, lc, ic, ih, ix, i, j, k, l, lnx, lnm
      integer kk, kkk, ss
      character*1 ci(30)
      character*33 hi(30)
      character*6 yi, zi(30)
      integer xln(30), mln(30), cr(30), hr(30)
      integer xr(30), ch(30)

      integer nwom,nch,nch0,nch1,nch2,nch3,nch4,nch5,nch6,nch7,nch8
      integer nch9,ncT
      integer mat,mat0,mat1,mat2,mat3,mat4,mat5,mat6,mat7
      integer mat8,mat9,matT
      integer unmat,unmat0,unmat1,unmat2,unmat3,unmat4,unmat5,unmat6
      integer unmat7,unmat8,unmat9,unmatT

C..................................................................
      open (unit=2, file='thai80.clean', status='old',
     $     access='sequential', form='formatted')
      open (unit=3, file='thai80.extract', status='new',recl=201)
      open (unit=4, file='thai80.stats', status='new')      
*     initializing all variables
      
      data ci/30*' '/, hi/30*' '/
      data lv/'0123456789'/
      data xln/30*0/,mln/30*0/,cr/30*0/,hr/30*0/
      data xr/30*0/,ch/30*0/
      
      data ci/30*' '/, hi/30*' '/,xi/30*' '/,yi/' '/
      data nxt/' '/, old/' '/, ka/'        '/
      data rl/0/,sx/0/,ag/0/,mr/0/,lc/0/,ic/0/,ih/0/,ix/0/,i/0/
      data j/0/,k/0/,l/0/,j/0/,k/0/,l/0/,m/0/,n/0/,o/0/,lnx/0/
      data lnm/0/,th/0/,tn/0/,x/0/,y/0/,u/0/,v/0/,s/0/,flag/.true./

      data nwom/0/,nch/0/,nch0/0/,nch1/0/,nch2/0/,nch3/0/,nch4/0/
      data nch5/0/,nch6/0/,nch7/0/,nch8/0/,nch9/0/,nchT/0/
      data mat/0/,mat0/0/,mat1/0/,mat2/0/,mat3/0/,mat4/0/
      data mat/5/,mat6/0/,mat7/0/,mat8/0/,mat9/0/,matT/0/
      data unmat/0/,unmat0/0/,unmat1/0/,unmat2/0/,unmat3/0/,unmat4/0/
      data unmat/5/,unmat6/0/,unmat7/0/,unmat8/0/,unmat9/0/,unmatT/0/
     

      ii=0
         do 3000 while (ii.eq.0)
            old=nxt
            read (2,1,end=1000, err=2000)nxt
 1          format(97A)

**          match husbands and wives   **
	    qq=0
            if ((old(1:16)).ne.(nxt(1:16))) then
	        p1=false
		p2=false
		p=0
		q1=false
		q2=false
               if (ix.gt.0) then
                  do 11 j=1,ix
                     if ((xi(j)(37:37)).eq.'2') then 
                        do 12 k=1,ih
                           if ( ((xr(j).eq.1).and.(hr(k).eq.2)).or.
     $                          ((xr(j).eq.2).and.(hr(k).eq.1)).or.
     $                          (((xr(j).gt.2).and.(xr(j).lt.6))
     $                          .and.(hr(k).eq.6)).or.
     $                          ((xr(j).eq.6).and.((hr(k).gt.2)
     $                          .and.(hr(k).lt.6))).or.
     $                          ((xr(j).gt.6).and.
     $                          (xr(j).eq.hr(k))) ) then
                                xi(j)(139:139)='1'
				xi(j)(140:172)=hi(k)
                                hr(k)=0
                                goto 201
                           end if
 12                     enddo
                     end if


 201                  if ((xi(j)(139:139)).ne.'1') then
   			 xi(j)(139:139)='0'
      			 xi(j)(140:172)=' '
		      endif
 11               enddo
                  
*                 match children and mothers    *
		  kk=1
		  kkk=1
		  ss=0
                  do 301 j=1,ix
                     ka(1:8)='        '
                     if ((xi(j)(37:37)).gt.'1') then
			ka(1:8)='         '
			qq=0
			qqq=0
			qqqq=0
			q1=false
                        do 302 k=kk,ic
			   f1=0
			   f2=0
			   f3=0
			   f4=0
			   f5=0
			   f6=0
			   f7=0
			   f8=0
			   f9=0
			   f10=0
			   f11=0
			   f12=0
			   f13=0
                           s=len(ka)
                           if ((qqq.lt.11).and.(qqq.lt.ch(j))) f1=1
                           if ((mln(k).gt.0).and.(cr(k).ne.5)) f2=1
                           if ((f1.eq.1).and.(f2.eq.1)) f3=1 
                           if ((xr(j).eq.1).or.(xr(j).eq.2)) f4=1
                           if ((cr(k).eq.3).or.(cr(k).eq.4)) f5=1
                           if ((f4.eq.1).and.(f5.eq.1)) f6=1
                           if (((xr(j).gt.2).and.
     $                          (xr(j).lt.7)).and.(cr(k).eq.7))f7=1
                           if (((xr(j).gt.7).and.
     $                          (xr(j).lt.11)).and.(cr(k).eq.10))f8=1
                           if ((xr(j).gt.10).and.(xr(j).eq.cr(k))) f9=1
                           if ((f7.eq.1).or.
     $                          (f8.eq.1).or.(f9.eq.1)) f10=1
                           if ((f6.eq.1).or.(f10.eq.1)) f11=1
                           if ((f11.eq.1).or.(xln(j).eq.mln(k)))f12=1
                           if ((f3.eq.1).and.(f12.eq.1)) f13=1
			   if (xln(j).eq.mln(k)) f13=1
                           if (f13.eq.1) then
			      q1=true
			      if (ci(k).ne.' ')qqq=qqq+1
			      qq=qq+1
			      kkk=qq
			      ka(qqq:qqq)=ci(k)
                              cr(k)=0
                              mln(k)=0
			      qqqq=qq+qq

			      mat=mat+1
			      if (ci(ic).eq.'0') mat0=mat0+1
			      if (ci(ic).eq.'1') mat1=mat1+1
			      if (ci(ic).eq.'2') mat2=mat2+1
		  	      if (ci(ic).eq.'3') mat3=mat3+1
			      if (ci(ic).eq.'4') mat4=mat4+1
			      if (ci(ic).eq.'5') mat5=mat5+1
			      if (ci(ic).eq.'6') mat6=mat6+1
			      if (ci(ic).eq.'7') mat7=mat7+1
			      if (ci(ic).eq.'8') mat8=mat8+1
			      if (ci(ic).eq.'9') mat9=mat9+1
			      if (ci(ic).eq.'T') matT=matT+1

                          endif
 302                    continue


                     endif

		  if ((q1.eq.true).and.(qqq.gt.0)) then	
		     xi(j)(173:173)=lv(qqq+1:qqq+1)
		     xi(j)(174:181)=ka
		  else
		     xi(j)(173:173)=lv(qqq+1:qqq+1)
		     xi(j)(174:181)=ka
		  endif

		  kk=kkk
		  ka(1:8)='        '
		  qq=0
		  qqq=0
		  qqqq=0
		  q1=false
		  q2=false
 301              continue
                  
		  qq=0
		  qqq=0
                  
**                tag unmatched children to woman No.1
                  ka2(1:16)='                '
		  p=0
                  do 401 j=1,ic
                     if ((cr(j).gt.0).and.(p.lt.9)) then 
		        p=p+1
			ka2(p:p+1)=ci(j)
			p1=true
			unmat=unmat+1
			if (ci(ic).eq.'0') unmat0=unmat0+1
			if (ci(ic).eq.'1') unmat1=unmat1+1
			if (ci(ic).eq.'2') unmat2=unmat2+1
		  	if (ci(ic).eq.'3') unmat3=unmat3+1
			if (ci(ic).eq.'4') unmat4=unmat4+1
			if (ci(ic).eq.'5') unmat5=unmat5+1
			if (ci(ic).eq.'6') unmat6=unmat6+1
			if (ci(ic).eq.'7') unmat7=unmat7+1
			if (ci(ic).eq.'8') unmat8=unmat8+1
			if (ci(ic).eq.'9') unmat9=unmat9+1
			if (ci(ic).eq.'T') unmatT=unmatT+1


		     endif		
 401              continue
                  
		  if ((p1.eq.true).and.(p.lt.1)) then 
			xi(1)(182:182)=' '
			xi(1)(183:183)=lv(1:1)
		  else if ((p1.eq.true).and.
     $ 			   (p.ge.1)) then
			xi(1)(182:182)=' '
			xi(1)(183:183)=lv(p+1:p+1)
			xi(1)(184:199)=ka2
		  else
			xi(1)(184:199)=' '
		  endif



**                writing output		  
                    do j=1,ix
   		    write(3,*)xi(j)
                    enddo
                endif
               
**             resetting all variables
                th=th+1
		ic=0
		ih=0
		ix=0
		lnx=0
		lnm=0
		rl=0
		ag=0
		sx=0
		mr=0
		lc=0

	       do jj=1,30
		xln(jj)=0
		mln(jj)=0
		cr(jj)=0
		hr(jj)=0
		xr(jj)=0
		ch(jj)=0
		ci(jj)=' '
		hi(jj)=' '
		xi(jj)=' '
	       enddo


		ka=' '
		ih=0
		ka(1:8)=' '
		ka2=' '
		q=0
		p=0
               tn=0
	       ix=0
           endif
*________________________________________________________________

	   
            if ((nxt(17:17)).eq.'1') then
               read ((nxt(23:26)),'(i4)')lnx
               read ((nxt(27:28)),'(i2)')rl
               read ((nxt(83:84)),'(i2)')ag
               read ((nxt(37:37)),'(i1)')sx

               if (ag.gt.10) then
                  read ((nxt(40:40)),'(i1)')mr
                  read ((nxt(50:51)),'(i2)')lnm
               else
                  read ((nxt(50:51)),'(i2)')lnm
                  mr=0
               end if
               
               if ((sx.eq.2).and.(mr.gt.1).and.(mr.lt.7)) then
                  read ((nxt(69:70)),'(i2)')lc
               else lc=0
               end if
               
               if (lnm.gt.31)lnm=0
            end if	
            
            
            
            if ( (tn.lt.300).and.((rl.gt.0).and.(rl.lt.13)) .and. 
     $           (((ag.ge.0).and.(ag.lt.11)).or. 
     $           ((sx.eq.1).and.(ag.gt.14).and.
     $           (ag.lt.99).and.(mr.eq.2)).or.
     $           ((sx.eq.2).and.(ag.gt.14).and.
     $           (ag.lt.66).and.(mr.lt.7))  ) ) then
               tn=tn+1

*              **keep needed child info**
               if (ag.lt.11)  then
                  ic=ic+1
                  cr(ic)=rl
                  ci(ic)=(nxt(84:84))
		  if (ag.eq.10) ci(ic)='T'
                  mln(ic)=lnm

		  nch=nch+1
		  if (ci(ic).eq.'0') nch0=nch0+1
		  if (ci(ic).eq.'1') nch1=nch1+1
		  if (ci(ic).eq.'2') nch2=nch2+1
		  if (ci(ic).eq.'3') nch3=nch3+1
		  if (ci(ic).eq.'4') nch4=nch4+1
		  if (ci(ic).eq.'5') nch5=nch5+1
		  if (ci(ic).eq.'6') nch6=nch6+1
		  if (ci(ic).eq.'7') nch7=nch7+1
		  if (ci(ic).eq.'8') nch8=nch8+1
		  if (ci(ic).eq.'9') nch9=nch9+1
		  if (ci(ic).eq.'T') nchT=nchT+1


*              **keep needed husband info**
               else if (sx.eq.1) then
                  ih=ih+1
                  hr(ih)=rl
                  hi(ih)=(nxt(83:84))//(nxt(38:39)) ! ag,v19
     $                 //' '//(nxt(55:56))//'  ' ! v28,NA
     $                 //' '//(nxt(57:57))//'  ' ! lit,sc
     $                 //' '//(nxt(41:43)) ! occup
     $                 //' '//(nxt(44:46)) ! indus
     $                 //(nxt(47:47))//(nxt(77:79)) ! v23,v41
     $                 //(nxt(80:81))//'      ' ! v42,6 space

*              **keep needed women info**
               else
                  if ((lc.lt.0).or.(lc.gt.30))lc=0
                  ix=ix+1
                  xr(ix)=rl
                  ch(ix)=lc
                  xln(ix)=lnx
		  nwom=nwom+1
*-------------------------------------------------------------------
*        Attaching computed HH# as character string 


		  if (th.lt.10) then
		    yi(6:6)=lv(th+1:th+1)
		    yi(1:5)='    '
		  else if ((th.ge.10).and.(th.lt.100)) then
		    th1=th
		    thc1=0
		    do while (th1.ge.10)
			th1=th1-10
			thc1=thc1+1
		    enddo
		    yi(6:6)=lv(th1+1:th1+1)
		    yi(5:5)=lv(thc1+1:thc1+1)
		    yi(1:4)='    '
		  else 
		    th2=th
		    thc2=0
		    thc3=0
		    thc4=0
		    thc5=0
		    thc6=0
		    do while (th2.ge.100)
			th2=th2-100
			thc2=thc2+1
			  if (thc2.eq.10) then
			   thc4=thc4+1
			   thc2=0
			   if (thc4.eq.10) then
			     thc5=thc5+1
			     thc4=0
			      if (thc5.eq.10) then
				thc6=thc6+1
				thc5=0
			      endif
			   endif  
			  endif
		    enddo
		    thc3=0
		    do while (th2.ge.10)
			th2=th2-10
			thc3=thc3+1
			if (thc3.eq.10) then
			  thc2=thc2+1
			  thc3=0
			  if (thc2.eq.10) then
			    thc4=thc4+1
			    thc2=0
			    if (thc4.eq.10) then
			      thc5=thc5+1
			      thc4=0
			      if (thc5.eq.10) then
				thc6=thc6+1
				thc5=0
			      endif
			    endif
			  endif
			endif
		    enddo
		    if ((th.ge.100).and.(th.lt.1000)) then
		     yi(6:6)=lv(th2+1:th2+1)
		     yi(5:5)=lv(thc3+1:thc3+1)
		     yi(4:4)=lv(thc2+1:thc2+1)
		     yi(1:3)='   '
		    endif
		    if ((th.ge.1000).and.(th.lt.10000)) then
		     yi(6:6)=lv(th2+1:th2+1)
		     yi(5:5)=lv(thc3+1:thc3+1)
		     yi(4:4)=lv(thc2+1:thc2+1)
		     yi(3:3)=lv(thc4+1:thc4+1)
		     thc4=0
		    endif
		    if ((th.ge.10000).and.(th.lt.100000)) then
		     yi(6:6)=lv(th2+1:th2+1)
		     yi(5:5)=lv(thc3+1:thc3+1)
		     yi(4:4)=lv(thc2+1:thc2+1)
		     yi(3:3)=lv(thc4+1:thc4+1)
		     yi(2:2)=lv(thc5+1:thc5+1)
		     thc4=0
		     thc5=0
		    endif
		    if (th.ge.100000) then
		     yi(6:6)=lv(th2+1:th2+1)
		     yi(5:5)=lv(thc3+1:thc3+1)
		     yi(4:4)=lv(thc2+1:thc2+1)
		     yi(3:3)=lv(thc4+1:thc4+1)
		     yi(2:2)=lv(thc5+1:thc5+1)
		     yi(1:1)=lv(thc6+1:thc6+1)
		     thc4=0
		     thc5=0
		     thc6=0
		    endif
		  endif

*-------------------------------------------------------------------

                  xi(ix)=yi(1:6)//' '//(nxt(1:12))!area var
     $                 //' '//(nxt(18:21)) ! urb, HHsz
     $                 //(nxt(91:97)) !ght
     $                 //(nxt(83:84))//(nxt(27:28)) ! ag,rl
     $                 //' '//(nxt(40:40)) ! mar status
     $                 //'   '//' '//(nxt(48:49)) ! eth, lang
     $                 //'  '//(nxt(52:52)) ! religion
     $                 //'  '//(nxt(36:36)) ! res status
     $                 //(nxt(38:39))//' '//(nxt(55:56)) ! v19, v28
     $                 //'  '//' '//(nxt(57:57))//'  ' ! na, lit, sga
     $                 //'  '//'  '//(nxt(53:54))//'    ' ! mig, br1-2
     $                 //'  '//(nxt(60:61)) ! prvres1
     $                 //'  '//(nxt(62:63)) ! prvres2
     $                 //(nxt(58:59)) ! dur res
     $                 //' '//(nxt(64:66)) ! v33, v34
     $                 //(nxt(67:68)) ! AgeMar
     $                 //(nxt(89:90)) ! DurMar
     $                 //'  '//'  ' ! OthMar
     $                 //' '//(nxt(75:75))//' '//(nxt(76:76)) !bcl-2
     $                 //(nxt(85:86))//'  '//'  ' ! cebl-3
     $                 //(nxt(87:88))//(nxt(69:72)) ! lch1-3
     $                 //(nxt(73:74))//'        ' ! ChDead,Others
     $                 //' '//(nxt(41:43)) ! occup
     $                 //' '//(nxt(44:46)) ! indus
     $                 //(nxt(47:47))//(nxt(77:79)) ! v23,v41
     $                 //(nxt(80:81))//'      ' ! v42
               end if
	  
            end if

 3000    continue
 2000 write (6,*)'ERROR CODE'
 1000 write (6,*)'EOF - Natural Exit'
      write (6,*)'Closing input and output files'

      write (4,*)'Number of Women                         =  ',nwom
      write (4,*)'Number of Child                         =  ',nch
      write (4,*)'Number of child with age 0              =  ',nch0
      write (4,*)'Number of child with age 1              =  ',nch1
      write (4,*)'Number of child with age 2              =  ',nch2
      write (4,*)'Number of child with age 3              =  ',nch3
      write (4,*)'Number of child with age 4              =  ',nch4
      write (4,*)'Number of child with age 5              =  ',nch5
      write (4,*)'Number of child with age 6              =  ',nch6
      write (4,*)'Number of child with age 7              =  ',nch7
      write (4,*)'Number of child with age 8              =  ',nch8
      write (4,*)'Number of child with age 9              =  ',nch9
      write (4,*)'Number of child with age T              =  ',nchT
      write (4,*) '   '
      write (4,*) '   '
      write (4,*)'Number of total matched child           =  ',mat
      write (4,*)'Number of matched child with age 0      =  ',mat0
      write (4,*)'Number of matched child with age 1      =  ',mat1
      write (4,*)'Number of matched child with age 2      =  ',mat2
      write (4,*)'Number of matched child with age 3      =  ',mat3
      write (4,*)'Number of matched child with age 4      =  ',mat4
      write (4,*)'Number of matched child with age 5      =  ',mat5
      write (4,*)'Number of matched child with age 6      =  ',mat6
      write (4,*)'Number of matched child with age 7      =  ',mat7
      write (4,*)'Number of matched child with age 8      =  ',mat8
      write (4,*)'Number of matched child with age 9      =  ',mat9
      write (4,*)'Number of matched child with age T      =  ',matT
      write (4,*) '   '
      write (4,*) '   '
      write (4,*)'Number of total unmatched child         =  ',unmat
      write (4,*)'Number of unmatched child with age 0    =  ',unmat0
      write (4,*)'Number of unmatched child with age 1    =  ',unmat1
      write (4,*)'Number of unmatched child with age 2    =  ',unmat2
      write (4,*)'Number of unmatched child with age 3    =  ',unmat3
      write (4,*)'Number of unmatched child with age 4    =  ',unmat4
      write (4,*)'Number of unmatched child with age 5    =  ',unmat5
      write (4,*)'Number of unmatched child with age 6    =  ',unmat6
      write (4,*)'Number of unmatched child with age 7    =  ',unmat7
      write (4,*)'Number of unmatched child with age 8    =  ',unmat8
      write (4,*)'Number of unmatched child with age 9    =  ',unmat9
      write (4,*)'Number of unmatched child with age T    =  ',unmatT

      close (2)
      close (3)
      close (4)
      stop
      end