      program mapprobwfi5s
C.........................................................................June 2021
C
C Combine W+- levels results ito Proxy GIM-W-index map
C Produce W+- levels results for Wup and Wlo
C Add Driving Phase Wup Wlo for testing or modelling set
C
C maps WGTEC for selected SOLPHASE with GTEC-Shub median for 9 extreme storms SAC23
C    .....................................................................Mar 2021
C Probability GIM-PWf of Wf = -1, -2,-3,-4,+1, +2,+3,+4 for a month
C at each grid on a map
C
      CHARACTER*128 INFILE,INPHASE,OUTFILE,INSTORM
	      CHARACTER*2 AYR,AMN,ADY,AUT,AMM,NSTRM(9),ANN
	+,BYR,BMN,BDY,BUT
	DIMENSION prob(0:72),iwf(0:72),iprob(0:72),xmap(0:72,71)
	+,imapwu(0:72,71),imapwl(0:72,71)
	+,icp_1(0:72,71),icp_2(0:72,71),icp_3(0:72,71),icp_4(0:72,71)
	+,icpx1(0:72,71),icpx2(0:72,71),icpx3(0:72,71),icpx4(0:72,71)
	+,icn_1(0:72,71),icn_2(0:72,71),icn_3(0:72,71),icn_4(0:72,71)
	+,icnx1(0:72,71),icnx2(0:72,71),icnx3(0:72,71),icnx4(0:72,71)
	+,icp01(0:72,71),icp02(0:72,71),icp03(0:72,71),icp04(0:72,71)
	+,icp11(0:72,71),icp22(0:72,71),icp33(0:72,71),icp44(0:72,71)
	+,icn01(0:72,71),icn02(0:72,71),icn03(0:72,71),icn04(0:72,71)
	+,icn11(0:72,71),icn22(0:72,71),icn33(0:72,71),icn44(0:72,71)
C	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
	DATA NSTRM/'12','13','15','16','17','19','20','21','22'/
C
      instorm='wulephasNNsm.txt'
      inphase='wuwlphasMM.txt' !Wu/WL phase for 3 days => output proxy GIM-Wx index
       infile='d:\web\gtc\YY\MM\wsMMDDUTMM.sYY'   !JPL-15min Shub median 
	 outfile='d:\web\graf\duc\YR\MN\ut\wxMNDDUT.sYR' !combined proxy W-index 1h step
C
   37 format(1X,I4,2I2,1X,I2,2(1X,F6.3))
        write(*,*) ' Enter ANN for output GIM-W: '
	read(*,*) ANN
	inphase(9:10)=ANN
	OPEN(13,file=inphase,action='READ')
C
C Cycle on 72 1h GIM-Wu/Wl maps:
C   
       DO 121 ihr=0,71
       read(13,37,end=49) kyear,kmn,kdy,kut,phiwup,phiwlo  ! for output files
	kyr=kyear-(kyear/100)*100
      call blet2(kyr,BYR)
	call blet2(kmn,BMN)
	call blet2(kdy,BDY)
      call blet2(kut,BUT)
c	 outfilep='d:\web\graf\YR\MN\ut\wxMNDDUT.sYR' !combined proxy W-index 1h step
	outfile(17:18)=BYR
	outfile(36:37)=BYR
	outfile(20:21)=BMN
	outfile(28:29)=BMN
	outfile(30:31)=BDY
	outfile(32:33)=BUT

C      Cycle on SOLPHI  Main phase
C WUP
        IF (phiwup.le.1.) THEN	  !phi positive.
        iflag_1=0
        phi0up=phiwup-0.025  ! 
	if (phiwup.eq.0.) phi0up=phiwup
	phi1up=phi0up+0.025  !
	if (phi1up.gt.1.) phi1up=1.
	                  ENDIF
	  IF (phiwup.lt.0.) THEN	   !phi negative.
        iflag_1=1
	phi0up=phiwup-0.025
	if (phiwup.lt.-1.0) phi0up=-1.
	phi1up=phi0up-0.025		   
      if (ihr.eq.71) phi1up=phiwup
      endif
C WLO
        IF (phiwlo.le.1.) THEN	  !phi positive.
        iflag_2=0
        phi0l=phiwlo-0.025  ! 
	if (phiwlo.eq.0.) phi0l=phiwlo
	phi1l=phi0l+0.025  !
	if (phi1l.gt.1.) phi1lo=1.
	                  ENDIF
	  IF (phiwlo.lt.0.) THEN	   !phi negative.
        iflag_2=1
	phi0lo=phiwlo-0.025
	if (phiwlo.lt.-1.0) phi0lo=-1.
	phi1lo=phi0lo-0.025		   
      if (ihr.eq.71) phi1lo=phiwlo
      endif
	cmapp=0.0
	cmapn=0.0
CREM      DO 551 jphi=1,10
C
	do i=1,71
	do k=0,72
	icp_1(k,i)=0
	icp_2(k,i)=0
	icp_3(k,i)=0
	icp_4(k,i)=0
	icpx1(k,i)=0
	icpx2(k,i)=0
	icpx3(k,i)=0
	icpx4(k,i)=0
	icn_1(k,i)=0
	icn_2(k,i)=0
	icn_3(k,i)=0
	icn_4(k,i)=0
	icnx1(k,i)=0
	icnx2(k,i)=0
	icnx3(k,i)=0
	icnx4(k,i)=0
	imapwu(k,i)=0
	imapwl(k,i)=0
	enddo
	enddo
C
   17	format(A2)
   30 FORMAT(1X,I4,2(1X,I2),1X,F5.2,2(1X,F6.2,1X,F6.3))
   13 FORMAT(I2)
   32 FORMAT(73(1X,I4))
C
C Cycle on extreme storms SC23
C
       DO 552 jev=1,9
c       DO 552 jev=1,4         ! 12, 13, 15, 16 => proxy 14
C	call blet2(jev,NN)
	instorm(9:10)=NSTRM(jev)
	OPEN(12,file=instorm,action='READ')
C
C Select range PHI
C
	DO 553 itime=0,96
	READ(12,30,end=554) iyyyy,imn,idy,RUT,wpos,fipos,wneg,fineg
C Wpos
	IF ((fipos.ge.phi0up).and.(fipos.le.phi1up)) THEN  !POSSSSSSSSSSSSSSSSSSSS
	cmapp=cmapp+1.0
	iyr=iyyyy-(iyyyy/100)*100
      call blet2(iyr,AYR)
	call blet2(imn,AMN)
	call blet2(idy,ADY)
	iut=int(rut)
      call blet2(iut,AUT)
	xmin=RUT-float(iut)/0.25*15.
	imin=int(xmin)
	call blet2(imin,AMM)
C
      infile(12:13)=AYR
	infile(30:31)=AYR
C
c1333	CONTINUE
C
	infile(15:16)=AMN
	infile(20:21)=AMN
C
       infile(22:23)=ADY
C
	    infile(24:25)=AUT
C
      infile(26:27)=AMM
      OPEN(10,file=infile,action='READ')
C
       do lat=1,71
	  read(10,32,end=35) (iwf(k),k=0,72) 
         do lon=0,72
	if (iwf(lon).eq.-1) icp_1(lon,lat)=icp_1(lon,lat)+1
	if (iwf(lon).eq.-2) icp_2(lon,lat)=icp_2(lon,lat)+1
      if (iwf(lon).eq.-3) icp_3(lon,lat)=icp_3(lon,lat)+1
	if (iwf(lon).eq.-4) icp_4(lon,lat)=icp_4(lon,lat)+1
	if (iwf(lon).eq.1) icpx1(lon,lat)=icpx1(lon,lat)+1
	if (iwf(lon).eq.2) icpx2(lon,lat)=icpx2(lon,lat)+1
	if (iwf(lon).eq.3) icpx3(lon,lat)=icpx3(lon,lat)+1
	if (iwf(lon).eq.4) icpx4(lon,lat)=icpx4(lon,lat)+1
	   enddo
       enddo
   35 close(unit=10)
                            ENDIF  !POSSSSSSSSSSSSSSS
C Wneg
	IF ((fineg.ge.phi0lo).and.(fineg.le.phi1lo)) THEN  !NEGGGGGGGGGGGGGGGGGG
	cmapn=cmapn+1.0
	iyr=iyyyy-(iyyyy/100)*100
      call blet2(iyr,AYR)
	call blet2(imn,AMN)
	call blet2(idy,ADY)
	iut=int(rut)
      call blet2(iut,AUT)
	xmin=RUT-float(iut)/0.25*15.
	imin=int(xmin)
	call blet2(imin,AMM)

C
      infile(12:13)=AYR
	infile(30:31)=AYR
C
c1333	CONTINUE
C
	infile(15:16)=AMN
	infile(20:21)=AMN
C
       infile(22:23)=ADY
C
	    infile(24:25)=AUT
C
      infile(26:27)=AMM
      OPEN(10,file=infile,action='READ')
C
       do lat=1,71
	  read(10,32,end=36) (iwf(k),k=0,72) 
         do lon=0,72
	if (iwf(lon).eq.-1) icn_1(lon,lat)=icn_1(lon,lat)+1
	if (iwf(lon).eq.-2) icn_2(lon,lat)=icn_2(lon,lat)+1
      if (iwf(lon).eq.-3) icn_3(lon,lat)=icn_3(lon,lat)+1
	if (iwf(lon).eq.-4) icn_4(lon,lat)=icn_4(lon,lat)+1
	if (iwf(lon).eq.1) icnx1(lon,lat)=icnx1(lon,lat)+1
	if (iwf(lon).eq.2) icnx2(lon,lat)=icnx2(lon,lat)+1
	if (iwf(lon).eq.3) icnx3(lon,lat)=icnx3(lon,lat)+1
	if (iwf(lon).eq.4) icnx4(lon,lat)=icnx4(lon,lat)+1
	   enddo
       enddo
   36 close(unit=10)
                            ENDIF  !NEGGGGGGGGGGGGGGGGGGGGGG
  553	CONTINUE       ! end 96 UT+MM times for NN event
  554	CLOSE(unit=12)
C
  552	CONTINUE       ! end 9 storms events
C 
C output results for selected PHI range
C
C =================================================
C POS results
C
	cntmon=cmapp       !POS					   Wup=-1
C       outfilep(7:8)='xx' ! med, max
C       outfilep(7:8)='_1'
	DO lat=1,71			!POS					   Wup=-1
	  do lon=0,72
      prob(lon)=icp_1(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icp_1(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
c	write(*,32) (iprob(k),k=0,72)
c	write(11,32) (iprob(k),k=0,72)
	ENDDO
c	close(unit=11)
	call median5183(xmap,medp_1,max_1)
C+	write(*,*) 'up_1: ',medp_1,max_1
C+	write(11,*) 'up_1: ',medp_1,max_1
C
	DO lat=1,71    !POS					   Wup=-2
	  do lon=0,72
      prob(lon)=icp_2(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icp_2(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
c	write(*,32) (iprob(k),k=0,72)
c	write(11,32) (iprob(k),k=0,72)
	ENDDO
c	close(unit=11)
	call median5183(xmap,medp_2,max_2)
c	write(*,*) 'up_2: ',medp_2,max_2
c	write(11,*) 'up_2: ',medp_2,max_2
C
	DO lat=1,71				   !POS					   Wup=-3
	  do lon=0,72
      prob(lon)=icp_3(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icp_3(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
c	write(*,32) (iprob(k),k=0,72)
c	write(11,32) (iprob(k),k=0,72)
	ENDDO
c	close(unit=11)
	call median5183(xmap,medp_3,max_3)
c	write(*,*) 'up_3: ',medp_3,max_3
c	write(11,*) 'up_3: ',medp_3,max_3
C
	DO lat=1,71					 !POS					   Wup=-4
	  do lon=0,72
      prob(lon)=icp_4(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icp_4(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
c	write(*,32) (iprob(k),k=0,72)
c	write(11,32) (iprob(k),k=0,72)
	ENDDO
c	close(unit=11)
	call median5183(xmap,medp_4,max_4)
c	write(*,*) 'up_4: ',medp_4,max_4
c	write(11,*) 'up_4: ',medp_4,max_4
C
	DO lat=1,71			   !POS					   Wup=+1
	  do lon=0,72
      prob(lon)=icpx1(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icpx1(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
c	write(*,32) (iprob(k),k=0,72)
c	write(11,32) (iprob(k),k=0,72)
	ENDDO
c	close(unit=11)
	call median5183(xmap,medp11,maxp11)
c	write(*,*) 'up11: ',medp11,maxp11
c	write(11,*) 'up11: ',medp11,maxp11
C
	DO lat=1,71				  !POS					   Wup=+2
	  do lon=0,72
      prob(lon)=icpx2(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icpx2(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
c	write(*,32) (iprob(k),k=0,72)
c	write(11,32) (iprob(k),k=0,72)
	ENDDO
c	close(unit=11)
	call median5183(xmap,medp22,maxp22)
c	write(*,*) 'up22: ',medp22,maxp22
c	write(11,*) 'up22: ',medp22,maxp22
C
	DO lat=1,71				   !POS					   Wup=+3
	  do lon=0,72
      prob(lon)=icpx3(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icpx3(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
c	write(*,32) (iprob(k),k=0,72)
c	write(11,32) (iprob(k),k=0,72)
	ENDDO
c	close(unit=11)
	call median5183(xmap,medp33,maxp33)
c	write(*,*) 'up33: ',medp33,maxp33
c	write(11,*) 'up33: ',medp33,maxp33
C
	DO lat=1,71				  !POS					   Wup=+4
	  do lon=0,72
      prob(lon)=icpx4(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icpx4(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
c	write(*,32) (iprob(k),k=0,72)
c	write(11,32) (iprob(k),k=0,72)
	ENDDO
c	close(unit=11)
	call median5183(xmap,medp44,maxp44)
c	write(*,*) 'up44: ',medp44,maxp44
c	write(11,*) 'up44: ',medp44,maxp44
C
C+++++++++++++++++++++++++++++++++++++++++
c		 ! up=-1
CNEWWWWWWWWWWWWWWWWWW Avoid Wneg for phi-pos:
         GOTO 333
       do lat=1,71
	   do lon=0,72
      kprob=icp_1(lon,lat)
	if ((kprob.ge.medp_1).and.(kprob.gt.icpx1(lon,lat))) then
	iprob(lon)=-1
	                    else
	iprob(lon)=0
	endif
	icp01(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icp_2(lon,lat)
	if ((kprob.ge.medp_2).and.(kprob.gt.icpx2(lon,lat))) then
	iprob(lon)=-2
	                    else
	iprob(lon)=0
	endif
	icp02(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icp_3(lon,lat)
	if ((kprob.ge.medp_3).and.(kprob.gt.icpx3(lon,lat))) then
	iprob(lon)=-3
	                    else
	iprob(lon)=0
	endif
	icp03(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icp_4(lon,lat)
	if ((kprob.ge.medp_4).and.(kprob.gt.icpx4(lon,lat))) then
	iprob(lon)=-4
	                    else
	iprob(lon)=0
	endif
	icp04(lon,lat)=iprob(lon)
	imapwu(lon,lat)=iprob(lon)
	    enddo
	    enddo
C  NEWWWWWWWWWWWWWWWW
  333       do lat=1,71
	   do lon=0,72
      kprob=icpx1(lon,lat)
	if ((kprob.ge.medp11).and.(kprob.gt.icp_1(lon,lat))) then
	iprob(lon)=1
	                    else
	iprob(lon)=0
	endif
	icp11(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icpx2(lon,lat)
	if ((kprob.ge.medp22).and.(kprob.gt.icp_2(lon,lat))) then
	iprob(lon)=2
	                    else
	iprob(lon)=0
	endif
	icp22(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icpx3(lon,lat)
	if ((kprob.ge.medp33).and.(kprob.gt.icp_3(lon,lat))) then
	iprob(lon)=3
	                    else
	iprob(lon)=0
	endif
	icp33(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icpx4(lon,lat)
	if ((kprob.ge.medp44).and.(kprob.gt.icp_4(lon,lat))) then
	iprob(lon)=4
	                    else
	iprob(lon)=0
	endif
	icp44(lon,lat)=iprob(lon)
      if (icpx4(lon,lat).gt.icn_4(lon,lat)) then 
		imapwu(lon,lat)=iprob(lon)
	endif
	    enddo
	    enddo
C================================================
C NEG results
	cntmon=cmapn       !NEG    					   
C
	DO lat=1,71		   !NEG    					   Wlo=-1
	  do lon=0,72
      prob(lon)=icn_1(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icn_1(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
	ENDDO
	call median5183(xmap,medn_1,maxn_1)
	DO lat=1,71				 !NEG    					   Wlo=-2
	  do lon=0,72
      prob(lon)=icn_2(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icn_2(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
	ENDDO
	call median5183(xmap,medn_2,maxn_2)
C
	DO lat=1,71			   !NEG    					   Wlo=-3
	  do lon=0,72
      prob(lon)=icn_3(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icn_3(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
	ENDDO
	call median5183(xmap,medn_3,maxn_3)
C
	 DO lat=1,71			  !NEG    					   Wlo=-4
	  do lon=0,72
      prob(lon)=icn_4(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icn_4(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
	ENDDO
	call median5183(xmap,medn_4,maxn_4)
C
	DO lat=1,71					!NEG    					   Wlo=+1
	  do lon=0,72
      prob(lon)=icnx1(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icnx1(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
	ENDDO
	call median5183(xmap,medn11,maxn11)
C
	DO lat=1,71				!NEG    					   Wlo=+2
	  do lon=0,72
      prob(lon)=icnx2(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icnx2(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
	ENDDO
	call median5183(xmap,medn22,maxn22)
C
	DO lat=1,71				 !NEG    					   Wlo=+3
	  do lon=0,72
      prob(lon)=icnx3(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icnx3(lon,lat)=iprob(lon)  ! Prob
	 xmap(lon,lat)=prob(lon)
	  enddo
	ENDDO
	call median5183(xmap,medn33,maxn33)
C
	DO lat=1,71					 !NEG    					   Wlo=+4
	  do lon=0,72
      prob(lon)=icnx4(lon,lat)/cntmon*10000.
	iprob(lon)=nint(prob(lon))
	icnx4(lon,lat)=iprob(lon)  ! Prob
	xmap(lon,lat)=prob(lon)
	  enddo
	ENDDO
  	call median5183(xmap,medn44,maxn44)
C------------------------------------------------
       do lat=1,71
	   do lon=0,72
      kprob=icn_1(lon,lat)
	if ((kprob.ge.medn_1).and.(kprob.gt.icnx1(lon,lat))) then
	iprob(lon)=-1
	                    else
	iprob(lon)=0
	endif
      icn01(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icn_2(lon,lat)
	if ((kprob.ge.medn_2).and.(kprob.gt.icnx2(lon,lat))) then
	iprob(lon)=-2
	                    else
	iprob(lon)=0
	endif
      icn02(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icn_3(lon,lat)
	if ((kprob.ge.medn_3).and.(kprob.gt.icnx3(lon,lat))) then
	iprob(lon)=-3
	                    else
	iprob(lon)=0
	endif
      icn03(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icn_4(lon,lat)
	if ((kprob.ge.medn_4).and.(kprob.gt.icnx4(lon,lat))) then
	iprob(lon)=-4
	                    else
	iprob(lon)=0
	endif
      icn04(lon,lat)=iprob(lon)
c//      imapwl(lon,lat)=iprob(lon)
      if (icn_4(lon,lat).gt.icpx4(lon,lat)) then 
	imapwu(lon,lat)=iprob(lon)
	endif
	    enddo
	    enddo
CMEWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW Avoid Wpos for phi_neg
        GOTO 334
CWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW
       do lat=1,71
	   do lon=0,72
      kprob=icnx1(lon,lat)
	if ((kprob.ge.medn11).and.(kprob.gt.icn_1(lon,lat))) then
	iprob(lon)=1
	                    else
	iprob(lon)=0
	endif
      icn11(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icnx2(lon,lat)
	if ((kprob.ge.medn22).and.(kprob.gt.icn_2(lon,lat))) then
	iprob(lon)=2
	                    else
	iprob(lon)=0
	endif
      icn22(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icnx3(lon,lat)
	if ((kprob.ge.medn33).and.(kprob.gt.icn_3(lon,lat))) then
	iprob(lon)=3
	                    else
	iprob(lon)=0
	endif
      icn33(lon,lat)=iprob(lon)
	    enddo
	    enddo
       do lat=1,71
	   do lon=0,72
      kprob=icnx4(lon,lat)
	if ((kprob.ge.medn44).and.(kprob.gt.icn_4(lon,lat))) then
	iprob(lon)=4
	                    else
	iprob(lon)=0
	endif
      icn44(lon,lat)=iprob(lon)
      if(imapwl(lon,lat).eq.0) imapwl(lon,lat)=iprob(lon)
	    enddo
	    enddo
C
C Combine GIM-W-index Proxy +++++++++++++++++++++++
C
  334	OPEN(11,file=outfile)
c=		OPEN(12,file=outfilen)
C Lati cycle
      DO 122 lat=1,71
C Longi cycle
	   DO 123 lon=0,72
	IF(imapwu(lon,lat).ne.0) goto 123  ! W= +-4
	if((imapwu(lon,lat).eq.0).and.(icp33(lon,lat).eq.3)) then 
	 imapwu(lon,lat)=3                 !W = +3
	 goto 123
	endif
C/	if((imapwu(lon,lat).eq.0).and.(icp03(lon,lat).eq.-3)) then 
C/	 imapwu(lon,lat)=-3 			   !W = -3
C/	 goto 123
C/	endif
	if((imapwu(lon,lat).eq.0).and.(icp22(lon,lat).eq.2)) then 
	 imapwu(lon,lat)=2                  !W = +2 
	 goto 123
	endif
c/	if((imapwu(lon,lat).eq.0).and.(icp02(lon,lat).eq.-2)) then 
c/	 imapwu(lon,lat)=-2                !W = -2 
c/	 goto 123
c/	endif
	if((imapwu(lon,lat).eq.0).and.(icp11(lon,lat).eq.1)) then 
	 imapwu(lon,lat)=1                 !W = +1 
	 goto 123
	endif
c/	if((imapwu(lon,lat).eq.0).and.(icp01(lon,lat).eq.-1)) then 
c/	 imapwu(lon,lat)=-1                 !W = -1 
c/	 goto 123
c/	endif
  123 CONTINUE
C
C lon cycle for phi_neg:
C
	   DO 124 lon=0,72
	IF(imapwl(lon,lat).ne.0) goto 124  ! W= +-4
	if((imapwl(lon,lat).eq.0).and.(icn03(lon,lat).eq.-3)) then 
c/	 imapwl(lon,lat)=-3                 !W = -3
	 imapwu(lon,lat)=-3                 !W = -3
	 goto 124
	endif
c/	if((imapwl(lon,lat).eq.0).and.(icn33(lon,lat).eq.3)) then 
c/	 imapwl(lon,lat)=3 			   !W = +3
c/	 goto 124
c/	endif
	if((imapwl(lon,lat).eq.0).and.(icn02(lon,lat).eq.-2)) then 
c	 imapwl(lon,lat)=-2                  !W = -2 
	 imapwu(lon,lat)=-2                  !W = -2 
	 goto 124
	endif
	if((imapwl(lon,lat).eq.0).and.(icn22(lon,lat).eq.2)) then 
	 imapwl(lon,lat)=2                !W = +2 
	 goto 124
	endif
	if((imapwl(lon,lat).eq.0).and.(icn01(lon,lat).eq.-1)) then 
c/	 imapwl(lon,lat)=-1                 !W = -1 
	 imapwu(lon,lat)=-1                 !W = -1 
	 goto 124
	endif
c/	if((imapwl(lon,lat).eq.0).and.(icn11(lon,lat).eq.1)) then 
c/	 imapwl(lon,lat)=1                 !W = +1 
c/	 goto 124
c/	endif
  124 CONTINUE
	write(*,32) (imapwu(k,lat),k=0,72)
	write(11,32) (imapwu(k,lat),k=0,72)
c/	write(*,32) (imapwl(k,lat),k=0,72)
c/	write(12,32) (imapwl(k,lat),k=0,72)
  122 CONTINUE  ! End lat
      close(unit=11)
c/	close(unit=12)
C
  121 CONTINUE  ! End GIM-W maps for selected event
   49	close(unit=13)
C
551	CONTINUE
C
	pause ' '
	STOP
	END
