	PROGRAM TROPICS2
C
	PARAMETER(NX=43,NY=43,NY1=NY+1,NT=4000)
	REAL U1(NX,NY),U2(NX,NY),U3(NX,NY),V1(NX,NY1),V2(NX,NY1)
      REAL V3(NX,NY1),CLRAD1(NX,NY),CLRAD2(NX,NY),CLRAD3(NX,NY)
	REAL S1(NX,NY),S2(NX,NY),S3(NX,NY),SB1(NX,NY),SB2(NX,NY)
	REAL SB3(NX,NY),S0(NX,NY),S0I(NX,NY),W(NX,NY),X(NX),Y(NY),TI(NT)
	REAL SM1(NX,NY),SM2(NX,NY),SM3(NX,NY)
      REAL M1(NX,NY),M2(NX,NY),M3(NX,NY), DUM(NX)
	REAL WHOV(NX,NT),UHOV(NX,NT),VHOV(NX,NT)
      REAL MEQ,H,HM,N2,LX,LY,LD(NX),YM(NX),MF
	REAL MMOVIE(NX,NY,NT)
	INTEGER*4 IRAN
	CHARACTER*60 ANAME
	CHARACTER*10 KNAME
	CHARACTER*1 READOUTPUT,EPINT
C
C   Read in parameters from text file
C
	OPEN(UNIT=9,FILE='input.txt', STATUS='OLD')
	READ(9,5)
	READ(9,5)
	READ(9,*)CD
	READ(9,*)CK
	READ(9,*)UMEAN
	READ(9,*)USTAR
	READ(9,*)H
	READ(9,*)N2
	READ(9,*)EP0
	READ(9,*)RAD0
	READ(9,*)RFEED
	READ(9,*)DTHE
	READ(9,*)GAMMA
	READ(9,*)RADMOIST
	READ(9,*)EPINT
	READ(9,5)
	READ(9,*)TAU
	READ(9,*)TAUCL
	READ(9,*)TAUM
	READ(9,5)
	READ(9,*)LX
	READ(9,*)LY
	READ(9,*)SSTMAX
	READ(9,*)SSTMIN
	READ(9,*)DTEMP
	READ(9,*)YM0
	READ(9,*)YM1
	READ(9,*)SSTA
	READ(9,*)SSTY
	READ(9,*)SSTDY
	READ(9,5)
	READ(9,*)DT
	READ(9,*)ENDTIME
	READ(9,*)PRINTTIME
	READ(9,*)TMOVIE
	READ(9,*)PRINTMOVIE
	READ(9,*)READOUTPUT
    5 FORMAT(2X)
C
C  Define some thermodynamics and other constants
C
	CP=1005.
	ALV=2.5E6
	A=6.38E6
	PI=2.*ASIN(1.0)
	IRAN=9973
C
C  Normalize some parameters and define others
C
	CD=CD*1.0E-3
	CK=CK*1.0E-3
	H=H*1000.
	CDH=CD/H
	CKH=CK/H
	LX=2.*PI*A*LX/360.0
	LY=2.*PI*A*LY/360.0
	YM0=YM0*2.*PI*A/360.0
	YM1=YM1*2.*PI*A/360.0
	SSTY=SSTY*2.*PI*A/360.0
	SSTDY=SSTDY*2.*PI*A/360.0
	BETA=2.*PI/(12.*3600.*A)
	CHID=CP*DTEMP*LOG(350./(350.-DTHE))
	RAD0=RAD0*CP*DTEMP*2./(270.*24.*3600.)
c	HM=2.*CHID*(EP0+GAMMA)/(N2*EP0)
	TAU=TAU*3600.
	TAUI=1./MAX(TAU,1.0)
	TAUM=TAUM*24.*3600.
	TAUMI=1./TAUM
	TAUCL=TAUCL*3600.
	TAUCLI=1./TAUCL
	US2=USTAR**2
	ENDTIME=ENDTIME*24.*3600.
	PRINTTIME=PRINTTIME*3600.
	PRINTMOVIE=PRINTMOVIE*24.*3600.
	TMOVIE=TMOVIE*24.*3600.
	NY2=NY/2	
	NX2=NX/2
	DX=LX/FLOAT(NX-1)
	DY=2.*LY/FLOAT(NY-1)
	DXI=1./DX
	DYI=1./DY
C
C  This is the numerical damping used in the Asselin Filter of the leap frog time scheme
C
	DAMP=0.1
C
C  Create arrays of x and y variables
C
	DO I=1,NX
	 X(I)=DX*FLOAT(I-1)
c	 LD(I)=1000.*(1000.+800.*COS(2.*PI*X(I)/LX))
c	 YM(I)=1000.*(200.-200.*COS(2.*PI*X(I)/LX))
	 LD(I)=YM1
	 YM(I)=YM0
	END DO
	DO J=1,NY
	 Y(J)=DY*FLOAT(J-1-NY2)
	END DO
C
C	Initial conditions
C
	DO I=1,NX
	 DO J=1,NY
C
C  Here we prescribe the mean sea surface temperature distribution and add anomalies to it
C
	  SST=SSTMIN+(SSTMAX-SSTMIN)*EXP(-((Y(J)-YM(I))/LD(I))**2)
	  SST=SST+SSTA*EXP(-((Y(J)-SSTY)/SSTDY)**2)*COS(2.*PI*X(I)/LX)
C
	  SSTABS=SST+273.15
	  ES=6.112*EXP(17.67*SST/(243.5+SST))
	  QS=0.622*ES/(1013.-ES)
	  S0I(I,J)=DTEMP*(CP*LOG(SSTABS)+ALV*QS/SSTABS)	  
	  S1(I,J)=S0I(I,J)+28.*DTEMP
	  S2(I,J)=S1(I,J)
	  SB1(I,J)=S1(I,J)
	  SB2(I,J)=SB1(I,J)
	  SM1(I,J)=S1(I,J)-CHID
	  SM2(I,J)=SM1(I,J)
	  V1(I,J)=0.3*(RAN(IRA)-0.5)
	  V2(I,J)=V1(I,J)
	  U1(I,J)=0.5*(RAN(IRA)-0.5)
	  U2(I,J)=U1(I,J)
	  M1(I,J)=0.0
	  M2(I,J)=M1(I,J)
	  CLRAD1(I,J)=0.0
	  CLRAD2(I,J)=CLRAD1(I,J)
	 END DO
	 V1(I,NY1)=0.0
	 V2(I,NY1)=0.0
	END DO
c	U1(NX2,NY2)=-0.5
c	U2(NX2,NY2)=U1(NX2,NY2)
c	V1(NX2+2,NY2)=0.6
c	V2(NX2+2,NY2)=V1(NX2+2,NY2)
C
C  Restart from previous output, if desired
C
	IF(READOUTPUT.EQ.'y')THEN
	OPEN(UNIT=13,FILE='output/u.out',STATUS='OLD')
	OPEN(UNIT=14,FILE='output/v.out',STATUS='OLD')
	OPEN(UNIT=17,FILE='output/s.out',STATUS='OLD')
	OPEN(UNIT=18,FILE='output/sb.out',STATUS='OLD')
	OPEN(UNIT=19,FILE='output/sm.out',STATUS='OLD')
	OPEN(UNIT=20,FILE='output/m.out',STATUS='OLD')
C
	DO J=2,NY-1
	 READ(13,200)(U2(I,J),I=2,NX-1)
	 READ(14,200)(V2(I,J),I=2,NX-1)
	 READ(20,200)(DUM(I),I=2,NX-1)
	 DO I=2,NX-1
	  M2(I,J)=0.01*DUM(I)
	 END DO
	 READ(17,200)(DUM(I),I=2,NX-1)
	 DO I=2,NX-1
	  S2(I,J)=DTEMP*CP*LOG(DUM(I))
	 END DO
	 READ(18,200)(DUM(I),I=2,NX-1)
	 DO I=2,NX-1
	  SB2(I,J)=DTEMP*CP*LOG(DUM(I))
	 END DO
	 READ(19,200)(DUM(I),I=2,NX-1)
	 DO I=2,NX-1
	  SM2(I,J)=DTEMP*CP*LOG(DUM(I))
	 END DO
	 DO I=2,NX-1
	  S1(I,J)=S2(I,J)
	  SB1(I,J)=SB2(I,J)
	  U1(I,J)=U2(I,J)
	  V1(I,J)=V2(I,J)
	  SM1(I,J)=SM2(I,J)
	  M1(I,J)=M2(I,J)
	 END DO
	END DO
	CLOSE(13)
	CLOSE(14)
	CLOSE(17)
	CLOSE(18)
	CLOSE(19)
	CLOSE(20)
	END IF
C
	TIME=0.0
	TPRINT=0.0
	IPRINT=0
	TPRINTM=0.0
	IPRINTM=0
C
C	Time marching begins here
C
  100	CONTINUE
	TIME=TIME+DT
	TPRINT=TPRINT+DT
	TPRINTM=TPRINTM+DT
	IF(TIME.GE.ENDTIME)THEN
	 GOTO 300
	END IF
C
	DO I=1,NX
	 DO J=1,NY
C	  IF(X(I).LE.0.25*LX.OR.X(I).GE.0.75*LX)THEN
C	  S0(I,J)=S0I(I,J)+DTEMP*35.*COS(2.*PI*TIME/(40.*24.*3600.))*
C    1   COS(2.*PI*X(I)/LX)*EXP(-((Y(J)-YM(I))/(600.*1000.))**2)
C	  ELSE
	   S0(I,J)=S0I(I,J)
C	  END IF
	 END DO
	END DO
C
C	Boundary conditions
C
	DO I=1,NX
	 V2(I,1)=0.0
	 V2(I,2)=0.0
	 V2(I,NY)=0.0
	 S2(I,1)=S2(I,2)
	 S2(I,NY)=S2(I,NY-1)
	 U2(I,1)=0.0
	 U2(I,NY)=0.0
	END DO
C
	DO J=1,NY
	 U2(1,J)=U2(NX-1,J)
	 U2(NX,J)=U2(2,J)
	 V2(1,J)=V2(NX-1,J)
	 V2(NX,J)=V2(2,J)
	 S2(1,J)=S2(NX-1,J)
	 S2(NX,J)=S2(2,J)
	END DO	 
C
C  Calculate surface wind speed at various points and forcings for time evolution of variables
C
	DO I=2,NX-1
	 DO J=2,NY-1
	  VBAR=0.25*(V2(I-1,J)+V2(I,J)+V2(I,J+1)+V2(I-1,J+1))
	  VS=SQRT((U2(I,J)+UMEAN)**2+VBAR**2+US2)
C
	  FU=DXI*(S2(I,J)-S2(I-1,J))+BETA*Y(J)*VBAR-CDH*VS*U1(I,J)
C
	  UBAR=0.25*(U2(I+1,J)+U2(I,J)+U2(I+1,J-1)+U2(I,J-1))
	  VS=SQRT(V2(I,J)**2+(UBAR+UMEAN)**2+US2)
C
	  FV=DYI*(S2(I,J)-S2(I,J-1))-BETA*(Y(J)-0.5*DY)*UBAR-
     1    CDH*VS*V1(I,J)
C
	  W(I,J)=-H*(DXI*(U2(I+1,J)-U2(I,J))+DYI*(V2(I,J+1)-V2(I,J)))
C
	  UBAR=0.5*(U2(I+1,J)+U2(I,J))+UMEAN
	  VBAR=0.5*(V2(I,J+1)+V2(I,J))
	  VS=SQRT(UBAR**2+VBAR**2+US2)
	  IF(EPINT.EQ.'y')THEN
	   EP=1.-(1.-EP0)*(SB2(I,J)-SM2(I,J))/CHID
	   EP=MIN(EP,1.0)
	   EP=MAX(EP,EP0)
	   DENOM=MAX(0.1,(SB1(I,J)-SM1(I,J)))
        ELSE
	   EP=EP0
	   DENOM=CHID
	  END IF
	  MEQ=W(I,J)+CK*VS*(S0(I,J)-SB1(I,J))/DENOM
	  IF(SB2(I,J).LT.(S2(I,J)-1.))MEQ=0.0
C
	  IF(TAU.EQ.0.0)THEN
	   MF=0.0
	   M1(I,J)=MEQ
	   M2(I,J)=MEQ
        ELSE
	   MF=TAUI*(MEQ-M1(I,J))
	  END IF
C
	  RADEQ=RFEED*N2*(-W(I,J)+EP*(M2(I,J)-RAD0/(EP*N2)))+
     1   RAD0*(1.0-RADMOIST+RADMOIST*(SB1(I,J)-SM1(I,J))/CHID)
C
	  CLRADF=TAUCLI*(RADEQ-CLRAD1(I,J))
C
	  FS=N2*(-W(I,J)+EP*M2(I,J))-CLRAD1(I,J)
C
	  AMFAC=MIN(0.0,(W(I,J)-M2(I,J)))
C
	  FSB=(1./H)*(CK*VS*(S0(I,J)-SB1(I,J))+
     1    AMFAC*(SB1(I,J)-SM1(I,J)))
C
	  FAC=GAMMA*(M2(I,J)-RAD0/(EP*N2))
	  FAC=MAX(FAC,0.0)
C
	  FSM=(SB1(I,J)-SM1(I,J))*FAC/H
	  FSM=FSM+TAUMI*(SB1(I,J)-SM1(I,J)-CHID)
C	     
C	Advance in time
C
	  U3(I,J)=U1(I,J)+2.*DT*FU
	  V3(I,J)=V1(I,J)+2.*DT*FV
	  S3(I,J)=S1(I,J)+2.*DT*FS
	  M3(I,J)=M1(I,J)+2.*DT*MF
	  M3(I,J)=MAX(M3(I,J),0.0)
	  SB3(I,J)=SB1(I,J)+2.*DT*FSB
	  SB3(I,J)=MIN(SB3(I,J),S3(I,J))
	  SM3(I,J)=SM1(I,J)+2.*DT*FSM
	  SM3(I,J)=MIN(SM3(I,J),SB3(I,J))
	  SM3(I,J)=MAX(SM3(I,J),(SB3(I,J)-2.*CHID))
	  CLRAD3(I,J)=CLRAD1(I,J)+2.*DT*CLRADF
C
	 END DO
	END DO
C
C	Apply Asselin Filter
C
	DO I=1,NX
	 DO J=1,NY
	  U1(I,J)=U2(I,J)+DAMP*(U1(I,J)+U3(I,J)-2.*U2(I,J))
	  V1(I,J)=V2(I,J)+DAMP*(V1(I,J)+V3(I,J)-2.*V2(I,J))
	  S1(I,J)=S2(I,J)+DAMP*(S1(I,J)+S3(I,J)-2.*S2(I,J))
	  M1(I,J)=M2(I,J)+DAMP*(M1(I,J)+M3(I,J)-2.*M2(I,J))
	  SB1(I,J)=SB2(I,J)+DAMP*(SB1(I,J)+SB3(I,J)-2.*SB2(I,J))
	  SM1(I,J)=SM2(I,J)+DAMP*(SM1(I,J)+SM3(I,J)-2.*SM2(I,J)) 
	  CLRAD1(I,J)=CLRAD2(I,J)+DAMP*(CLRAD1(I,J)+CLRAD3(I,J)-
     1	  2.*CLRAD2(I,J))
C
	  U2(I,J)=U3(I,J)
	  V2(I,J)=V3(I,J)
	  S2(I,J)=S3(I,J)
	  M2(I,J)=M3(I,J)
	  SB2(I,J)=SB3(I,J)
	  SM2(I,J)=SM3(I,J)
	  CLRAD2(I,J)=CLRAD3(I,J)
	 END DO
	END DO
C
C	Create time series
C
	IF(TPRINT.GE.PRINTTIME)THEN
	 TPRINT=0.0
	 IPRINT=IPRINT+1
	 TI(IPRINT)=TIME/(3600.*24.)
	 DO I=1,NX
	  WHOV(I,IPRINT)=100.*W(I,NY2)
	  UHOV(I,IPRINT)=U2(I,NY2)
	  VHOV(I,IPRINT)=V2(I,NY2)
	 END DO
	END IF
C
C  Create movie
C
	IF(TIME.GT.(ENDTIME-TMOVIE-10.))THEN
	IF(TPRINTM.GE.PRINTMOVIE)THEN
	 TPRINTM=0.0
	 IPRINTM=IPRINTM+1
	 DO I=1,NX
	  DO J=1,NY
	   MMOVIE(I,J,IPRINTM)=100.*M2(I,J)
	  END DO
	 END DO
	END IF
	END IF
C
	GOTO 100
C
C	End of time integration
C
  300	CONTINUE
C
C Open output files
C
	OPEN(UNIT=10,FILE='output/t.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=11,FILE='output/x.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=12,FILE='output/y.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=13,FILE='output/u.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=14,FILE='output/v.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=15,FILE='output/w.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=16,FILE='output/m.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=17,FILE='output/s.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=18,FILE='output/sb.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=19,FILE='output/s0.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=20,FILE='output/sm.out',
     1   STATUS='UNKNOWN')
C
C  Print
C
	DO K=1,IPRINT
	 WRITE(10,200)TI(K)
	END DO
	WRITE(11,150)(0.001*X(I),I=2,NX-1)
	WRITE(12,150)(0.001*Y(J),J=2,NY-1)
C
	DO J=2,NY-1
	 WRITE(13,200)(U2(I,J),I=2,NX-1)
	 WRITE(14,200)(V2(I,J),I=2,NX-1)
	 WRITE(15,200)(100.*W(I,J),I=2,NX-1)
	 WRITE(16,200)(100.*M2(I,J),I=2,NX-1)
	 DO I=1,NX
	  DUM(I)=EXP(S2(I,J)/(CP*DTEMP))
	 END DO
	 WRITE(17,200)(DUM(I),I=2,NX-1)
	 DO I=1,NX
	  DUM(I)=EXP(SB2(I,J)/(CP*DTEMP))
	 END DO
	 WRITE(18,200)(DUM(I),I=2,NX-1)
	 DO I=1,NX
	  DUM(I)=EXP(S0(I,J)/(CP*DTEMP))
	 END DO
	 WRITE(19,200)(DUM(I),I=2,NX-1)
	 DO I=1,NX
	  DUM(I)=EXP(SM2(I,J)/(CP*DTEMP))
	 END DO
	 WRITE(20,200)(DUM(I),I=2,NX-1)
	END DO
C
  150	FORMAT(2X,81(F7.0,1X))
  200	FORMAT(2X,81(F7.2,1X))
  220 FORMAT(I2.2)
  221 FORMAT(I1)
C
	OPEN(UNIT=21,FILE='output/whov.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=22,FILE='output/uhov.out',
     1   STATUS='UNKNOWN')
	OPEN(UNIT=23,FILE='output/vhov.out',
     1   STATUS='UNKNOWN')
	DO K=1,IPRINT
	 WRITE(21,200)(WHOV(I,K),I=2,NX-1)
	 WRITE(22,200)(UHOV(I,K),I=2,NX-1)
	 WRITE(23,200)(VHOV(I,K),I=2,NX-1)
	END DO
	OPEN(UNIT=30,FILE='output/jlength.out',STATUS='UNKNOWN')
	WRITE(30,*) IPRINTM
C
	DO K=1,IPRINTM
	 K2=K+40
	 WRITE(KNAME,220)K
	 ANAME='output/umov'//KNAME
	 OPEN(UNIT=K2,FILE=ANAME,STATUS='UNKNOWN')
	 DO J=2,NY-1
	  WRITE(K2,200)(MMOVIE(I,J,K),I=2,NX-1)
	 END DO
	END DO
C
	STOP
	END

