C *************************************************************** C C PLOTS TEMPERATURE CONTOUR OF PRINCETON MODEL OUTPUT C USING NCAR GRAPHICS (4 plots/page) C SIGTOZ - interpolates sigma to z-levels C MAKCON - makes contour of data given on curvilinear grid C NZ= number of Z-levels; IZLEV= depths in meter. C Tal Ezer C **************************************************************** PROGRAM PLOT PARAMETER (IM=181,JM=101,KB=20,KBM1=KB-1) PARAMETER(NLAT=4,NLON=4,NZ=8,NREAD=NZ/4) DIMENSION BLON(NLON),BLAT(NLAT),IZLEV(NZ),ZLEV(NZ) C COMMON/BLK1D/DZR(KBM1), 1 Z(KB),ZZ(KB),DZ(KB),DZZ(KB) C---------------- 2-D ARRAYS ------------------------------------- COMMON/BLK2D/H(IM,JM),DX(IM,JM),DY(IM,JM),COR(IM,JM),ALN(IM,JM), 1 ALT(IM,JM),ALON(IM,JM),ALAT(IM,JM),FSM(IM,JM),ELB(IM,JM), 2 DUM(IM,JM),DVM(IM,JM),ART(IM,JM),ARU(IM,JM),ARV(IM,JM) C---------------- 3-D ARRAYS ------------------------------------- COMMON/BLK3D/TB(IM,JM,KB) C 1 ,SB(IM,JM,KB),UB(IM,JM,KB),VB(IM,JM,KB) C-------------------------------------------------------------------- CHARACTER*59 TITLE, TIT(3) CHARACTER*10 DATE CHARACTER*13 DAY(3) CHARACTER*15 TTIME,TCI CHARACTER*3 XLABEL,YLABEL CHARACTER*6 CLEV(4) CHARACTER*3 ZLON(NLON),ZLAT(NLAT) C C *** define levels for plotting C DATA IZLEV / 0 , 10 , 20 , 50 , 100 , 200 , 500 , 1000 / C ZLEV(:)=IZLEV(:)*(-1.) C C C LAND=1, FILL LAND AREA LAND=1 C C ************** INPUT/OUTPUT FILES ********************************* C C--------------- grid & bathymetry data ----------------------------- OPEN(40,FILE='/archive/o/tne/GULF/inHTS20.8805cl', 2 FORM='unformatted') C C---------E,T,S,U,V every 5d (24 d IC: OTIS)------------------------- C OPEN(76,FILE='/archive/o/tne/GULF/run20/ts.8910', 2 FORM='unformatted') C C OPEN(6,FILE='plot.out',FORM='formatted') C C C INITIALISE GKS C call opngks C C TURN OFF CLIPPING IND. (TO PLOT LABELS OUTSIDE MAP) C CALL GSCLIP(0) C C SET LINES WIDER THAN USUAL C C CALL GSLWSC(2.) C C C ************** define axis and titles for map **************** C TIME=0. C *** map boundaries: LAT | LON data XL,XR,YB,YT/-82.,-50.,26.,48./ C C *** map axis labeling DATA BLON /-50. ,-60. ,-70. ,-80. / DATA ZLON /'50W','60W','70W','80W'/ DATA BLAT / 30. , 35. , 40. , 45. / DATA ZLAT /'30N','35N','40N','45N'/ C C ------ SZ=0.5 - 4 plots/page ; SZ > 0.5 - 1 plot/page -------- SZ=.5 XLABEL='LON' YLABEL='LAT' C C *************** contour min max and interval ****************** C C------------------------ TEMPERATURE --------------------------- DATA CMIN,CMAX,CINT /1.,30., 1. / C C***************** read geometry & initial cond. ******************** C READ(40) KBB,Z,ZZ,DZ,DZZ,IMM,JMM,ALON,ALAT,DX,DY,H,FSM C 1 ,DUM,DVM,ART,ARU,ARV,COR,TB C C***************** read TEMP ******************** C DO 22 KDAY=1,5 22 READ(76) TIME,DATE,ELB,TB C C CALL PRXY(' TOPOGRAPHY ',TIME,H,IM,8,JM,4,1.) C CALL PRXY(' LONGITUDE ',TIME,ALON,IM,2,JM,2,.1) C CALL PRXY(' LATITUDE ',TIME,ALAT,IM,2,JM,2,.1) C C ******* STARTS READ AND PLOT SECTION ***************************** C C NREAD = no. of pages ; MAXX,MAXY = plots in x & y C total no. of plots = nread*maxx*maxy C TIME=-1. NPLOT=0 C DATA MAXX,MAXY/2,2/ C DATA X1,X2,Y1,Y2/0.1,0.95,0.1,0.95/ JSIZE=0 DO 2000 NPAGE=1,NREAD LP=0 DO 1000 NY=1,MAXY DO 1000 NX=1,MAXX LP=LP+1 NPLOT=NPLOT+1 C IF(NPLOT.GT.6)GO TO 9000 C WRITE(TITLE,'(I4,''M TEMP.- '',A10)')IZLEV(NPLOT),DATE C C *** interpolate data from SIGMA to Z-LEVELS C IF(IZLEV(NPLOT).EQ.0)THEN ELB(:,:)=TB(:,:,1) ELSE CALL SIGTOZ(ZZ,H,TB,ELB,ZLEV(NPLOT),FSM,IM,JM,KB) ENDIF C CALL PRXY(TITLE,TIME,ELB,IM,8,JM,3,1. ) C TIME=-1. C IF(SZ.GT.0.5 ) GO TO 25 x1=0.08+(nx-1)*0.45 x2=x1+0.42 y2=0.95-(ny-1)*0.50 y1=y2-0.4 jsize=14 jsiz2=12 C C **************** plot map ************************************** C 25 CALL MAPPOS(x1,x2,y1,y2) CALL SUPMAP (9,0.,0.,0.,YB,XL,YT,XR,2,5,0,0,IER) C FILL LAND IF(LAND.EQ.1)CALL COLRIT C C **************** plot lon lat ********************************** C CLAT=YB-1. CLON=XL-0.5 C---------------------- LATITUDE -------------------------------- C IF(NX.EQ.2)GO TO 52 do 50 i=1,NLAT call maptrn(BLAT(i),CLON ,xx,yy) 50 call pwritx(xx,yy,ZLAT(i),3,jsize,0,1) C C---------------------- LONGITUDE ------------------------------ C 52 CONTINUE do 55 i=1,NLON call maptrn(CLAT ,BLON(i),xx,yy) 55 call pwritx(xx,yy,ZLON(i),3,jsize,0,0) C C **************** plot title, time and contour interval ***** C CLAT=YT+1. CLON=XL call maptrn(CLAT ,CLON,xx,yy) call pwritx(xx,yy,TITLE,50,jsize,0,-1) C C *** print time C IF(TIME.LT.0.) GO TO 56 CLAT=YB+1.5 CLON=XL+8. WRITE(TTIME,'(''TIME= DAY'',F5.0)') TIME CALL MAPTRN(CLAT ,CLON,XX,YY) CALL PWRITX(XX,YY,TTIME,15,JSIZ2,0,-1) C C *** print contour interval C 56 IF(CINT.LE.0.) GO TO 58 CLAT=YB+1.5 CLON=XL+23. WRITE(TCI,'(''CI = '',F5.0)') CINT CALL MAPTRN(CLAT ,CLON,XX,YY) CALL PWRITX(XX,YY,TCI,15,JSIZ2,0,-1) C 58 CONTINUE C C ---------- transfer into NCAR supmap coordinates ------- C if(nplot.ne.1)go to 65 do 60 i=1,im do 60 j=1,jm C FSM1(I,J)=1. 60 call maptrn(ALAT(I,J),ALON(I,J),ALN(I,J),ALT(I,J)) 65 continue c c **************** make contour ********************************** C c *** optional laplasian smoother C CALL SMOOTH(ELB,FSM,IM,JM,4) C c *** plot contour C CALL MAKCON (0,IM,JM,ALN,ALT,ELB,FSM,CMIN,CINT,CMAX,1,SZ) c c 1000 continue call frame 2000 continue 9000 continue call clsgks stop 'PLOT' end C C SUBROUTINE COLRIT C C Define the array that holds the area map. C DIMENSION IAM(250000) C C Dimension the arrays needed by ARSCAM for edges. C DIMENSION XCS(10000),YCS(10000) C C Dimension the arrays needed by ARSCAM and ARDRLN for area and group C ids. C DIMENSION IAI(10),IAG(10) C C Define an array for aspect source flags. C DIMENSION IF(13) C C Declare the routine which will draw the contour lines avoiding labels C EXTERNAL SHADER C C Set the background color : white C CALL GSCR (1,0,1.,1.,1.) C C Re-set certain aspect source flags to "individual". C CALL GQASF (IE,IF) IF(11)=1 IF(12)=1 CALL GSASF (IF) C C Set the number of vertical strips and the group identifiers to C be used by MAPBLA. C CALL MAPSTI ('VS',150) CALL MAPSTI ('G1',1) CALL MAPSTI ('G2',2) C C Initialize EZMAP. C CALL MAPINT C C Initialize the area map. C CALL ARINAM (IAM,250000) C C Add edges to the area map. C CALL MAPBLA (IAM) C C Pre-process the area map. C CALL ARPRAM (IAM,0,0,0) C C Compute and print the amount of space used in the area map. C ISU=250000-(IAM(6)-IAM(5)-1) C PRINT * , 'SPACE USED IN AREA MAP IS ',ISU C C Set the background color. C CALL GSCR (1,1,0.,0.,0.) C C Color the map. C CALL ARSCAM (IAM,XCS,YCS,10000,IAI,IAG,10,SHADER) C C In black, draw a perimeter and outline all the countries. We turn C off the labels (since they seem to detract from the appearance of C the plot) and we reduce the minimum vector length so as to include C all of the points in the boundaries. C CALL MAPSTI ('LA',0) CALL MAPSTI ('MV',1) CALL MAPLBL CALL MAPLOT C C C Draw lines of latitude and longitude over water. They will be in C black because of the SETUSV call above. C c CALL MAPGRM (IAM,XCS,YCS,10000,IAI,IAG,10,COLRLN) C RETURN END C SUBROUTINE SHADER (XCS,YCS,NCS,IAI,IAG,NAI) DIMENSION XCS(*),YCS(*),IAI(*),IAG(*) C C This version of SHADER shades the ploygon whose edge is defined by C the points ((XCS(I),YCS(I)),I=1,NCS) if and only, relative to edge C group 3, its area identifier is a 1. The package SOFTFILL is used C to do the shading. C C Define workspaces for the shading routine. C dimension dst(1100),ind(1200) C C Turn off shading C iai1=-1 iai3=-1 do 10 i=1,nai if(iag(i).eq.1) iai1=iai(i) if(iag(i).eq.3) iai3=iai(i) 10 continue if(iai1.gt.0) then if(mapaci(iai1) .ne.1) then call sfseti('ANGLE',45) call SFSETR('SPACING',.008) C call SFSETR('SPACING',.001) CALL SFWRLD(XCS,YCS,NCS-1,DST,1100,IND,1200) CALL SFSETI('ANGLE',135) CALL SFNORM(XCS,YCS,NCS-1,DST,1100,IND,1200) END IF end if C RETURN C END C SUBROUTINE PRXY (LABEL,TIME,A,IM,ISKP,JM,JSKP,SCALA) C >>> C THIS WRITES A 2-D FIELD C TIME=TIME IN DAYS C A = ARRAY(IM,JM) TO BE PRINTED C ISKP=PRINT SKIP FOR I C JSKP=PRINT SKIP FOR J C SCALE=DIVISOR FOR VALUES OF A C DIMENSION A(IM,JM),NUM(IM),LINE(IM) CHARACTER LABEL*(*) DATA ZERO /1.E-10/ C SCALE=SCALA IF (SCALE.GT.ZERO) GO TO 160 AMX=ZERO DO 150 J=1,JM,JSKP DO 150 I=1,IM,ISKP AMX=MAX1(ABS(A(I,J)),AMX) 150 CONTINUE SCALE=10.**(INT(LOG10(AMX)+1.E2)-103) 160 CONTINUE SCALEI=1./SCALE WRITE(6,170) LABEL 170 FORMAT(1X,A40) WRITE(6,180) TIME,SCALE 180 FORMAT(' TIME =',F9.4,' DAYS MULTIPLY ALL VALUES BY',1PE10.3) DO 190 I=1,IM 190 NUM(I)=I IB=1 C 200 CONTINUE IE=IB+23*ISKP IF(IE.GT.IM) IE=IM WRITE(6,210) (NUM(I),I=IB,IE,ISKP) 210 FORMAT(/,2X,24I5,/) DO 260 J=1,JM,JSKP JWR=JM+1-J DO 220 I=IB,IE,ISKP 220 LINE(I)=INT(SCALEI*A(I,JWR)) WRITE(6,240) JWR,(LINE(I),I=IB,IE,ISKP) 240 FORMAT(1X,I3,24I5) 260 CONTINUE WRITE(6,280) 280 FORMAT(//) IF(IE.GE.IM) RETURN IB=IB+24*ISKP GO TO 200 END C SUBROUTINE SIGTOZ(ZZ,H,T,TLEV,ZLEV,FSM,IM,JM,KB) C------------------------------------------------------------------- C THIS ROUTINE LINERLY INTERPOLATES TLEV AT THE LEVEL, C ZLEV, FROM T LOCATED ON SIGMA LEVELS, ZZ. C NOTE THAT A NEW MASK ,FSM, IS CREATED. C------------------------------------------------------------------- DIMENSION ZZ(KB),H(IM,JM),T(IM,JM,KB),TLEV(IM,JM),FSM(IM,JM) TLEV=0. FSM=0. K=1 DO 200 J=1,JM DO 200 I=1,IM 100 CONTINUE IF(K.LT.1) GO TO 200 IF(K.GT.(KB-1)) THEN K=KB-2 GO TO 200 ENDIF C C FIND K AND K+1 INTERVAL THAT BRACKETS ZLEV, THEN INTERPOLATE C IF(ZLEV.LT.(ZZ(K)*H(I,J))) THEN IF(ZLEV.GE.(ZZ(K+1)*H(I,J))) THEN TLEV(I,J)=T(I,J,K)+(ZLEV-ZZ(K)*H(I,J)) 1 *(T(I,J,K+1)-T(I,J,K))/((ZZ(K+1)-ZZ(K))*H(I,J)) FSM(I,J)=1. GO TO 200 ELSE K=K+1 GO TO 100 ENDIF ELSE K=K-1 GO TO 100 ENDIF 200 CONTINUE RETURN END C SUBROUTINE SMOOTH(A,FSM,IM,JM,NITS) C------------------------------------------------------------------- C THIS ROUTINE SMOOTHS DATA WITH A FIVE POINT LAPLACIAN FILTER. C------------------------------------------------------------------- DIMENSION A(IM,JM),FSM(IM,JM) DO 100 N=1,NITS DO 200 J=2,JM-1 DO 200 I=2,IM-1 SMFAC=FSM(I+1,J)+FSM(I,J-1)+FSM(I-1,J)+FSM(I,J+1)+1.E-5 A(I,J)=A(I,J)+(.5/SMFAC) 1 *(A(I+1,J)*FSM(I+1,J)+A(I,J-1)*FSM(I,J-1) 2 +A(I-1,J)*FSM(I-1,J)+A(I,J+1)*FSM(I,J+1) 3 -SMFAC*A(I,J)) A(I,J)=A(I,J)*FSM(I,J) 200 CONTINUE 100 CONTINUE RETURN END C C----------------------------------------------------------------------- SUBROUTINE MAKCON(IND,IM,JM,X,Y,T,FSM,CMIN,CINT,CMAX,NU,SZ) C---------------------------------------------------------------------- C CREATES CONTOURS IN X,Y SPACE FROM T FIELD. X,Y AND T ARE 2-D C ARRAYS AND THEREFORE CAN REPRESENT ANY COORDINATE SYSTEM. C A SPECIAL NON-LINEAR INTERPOLATING FEATURE INVOLVING THE C FUNCTION COR HAS BEEN REMOVED FROM THIS VERSION. C C IND = 0; NEGATIVE CONTOURS ARE DASHED. IND = 1; ALL CONTOURS ARE SOLID. C NU = 1; CONTOURS ARE NUMBERED C IM,JM = ARRAY SIZE C X,Y = PLOTTING COORDINATES C T = VARIABLE TO BE CONTOURED C FSM(I,J) = 0; GRID IS MASKED OUT. FSM(I,J)=1; GRID IS PLOTTED. C CMIN,CINT,CMAX = CONTOUR MINIMUM, INTERVAL AND MAXIMUM C---------------------------------------------------------------------- PARAMETER (LMAX=10000) DIMENSION X(IM,JM),Y(IM,JM),T(IM,JM),FSM(IM,JM),C(500) DIMENSION XF(LMAX),YF(LMAX),XL(LMAX),YL(LMAX),XC(LMAX),YC(LMAX) CHARACTER*16 IPAT REAL XCR(LMAX),YCR(LMAX) DATA X1,X2,X3,X4,X5,X6,X7,X8/8*0./ DATA Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8/8*0./ EC=.00010*ABS(CMAX-CMIN) EC=0.0 DO 220 K=1,500 C(K)=CMIN+CINT*(K-1)+EC IF(C(K).GE.CMAX) GO TO 221 220 KCM=K 221 CONTINUE C----------------SOLVE FOR C(K) CONTOUR -------------------------------- DO 9999 K=1,KCM CO=C(K) C**** THIS SECTION COLLECTS ALL CELL VECTORS FOR EACH C(K) CONTOUR. **** C**** S=ANY NUMBER NOT IN (X,Y) RANGE. **** C**** REINSTATE ABS'S EX=.00001*ABS(X(1,JM)-X(1,1))+.00001*ABS(X(IM,JM)-X(IM,1)) EY=.00001*ABS(Y(1,JM)-Y(1,1))+.00001*ABS(Y(IM,JM)-Y(IM,1)) S=-1000. IMM1=IM-1 JMM1=JM-1 L=0 DO 960 J=1,JMM1 DO 960 I=1,IMM1 IF(L.GT.(LMAX-5)) THEN WRITE(6,'('' INCREASE LMAX IN MAKCON TO COMPLETE CONTOUR'')') GO TO 9990 ENDIF TSW=T(I,J) TSE=T(I+1,J) TNE=T(I+1,J+1) TNW=T(I,J+1) IF(CO.LE.TSW.AND.CO.LE.TNW.AND.CO.LE.TNE. 1 AND.CO.LE.TSE) GO TO 960 IF(CO.GT.TSW.AND.CO.GT.TNW.AND.CO.GT.TNE. 1 AND.CO.GT.TSE) GO TO 960 X1=S X2=S X3=S X4=S X5=S X6=S X7=S X8=S XSE=X(I+1,J) XSW=X(I,J) XNE=X(I+1,J+1) XNW=X(I,J+1) YSE=Y(I+1,J) YSW=Y(I,J) YNE=Y(I+1,J+1) YNW=Y(I,J+1) C****** FIND CELL INTERSECTIONS WITH CONTOUR *************************** IF(CO.GT.TNW.AND.CO.LT.TSW) GO TO 430 IF(CO.LT.TNW.AND.CO.GT.TSW) GO TO 430 GO TO 470 430 RA=(CO-TSW)/(TNW-TSW+.01*EC) RACOR=RA Y1=YSW+RACOR*(YNW-YSW) X1=XSW+RACOR*(XNW-XSW) 470 IF(CO.GT.TSE.AND.CO.LT.TSW) GO TO 480 IF(CO.LT.TSE.AND.CO.GT.TSW) GO TO 480 GO TO 520 480 RA=(CO-TSW)/(TSE-TSW+.01*EC) RACOR=RA X3=XSW+RACOR*(XSE-XSW) Y3=YSW+RACOR*(YSE-YSW) 520 IF(CO.GT.TSE.AND.CO.LT.TNE) GO TO 530 IF(CO.LT.TSE.AND.CO.GT.TNE) GO TO 530 GO TO 560 530 RA=(CO-TSE)/(TNE-TSE+.01*EC) RACOR=RA X5=XSE+RACOR*(XNE-XSE) Y5=YSE+RACOR*(YNE-YSE) 560 IF(CO.GT.TNW.AND.CO.LT.TNE) GO TO 570 IF(CO.LT.TNW.AND.CO.GT.TNE) GO TO 570 GO TO 600 570 RA=(CO-TNW)/(TNE-TNW+.01*EC) RACOR=RA X7=XNW+RACOR*(XNE-XNW) Y7=YNW+RACOR*(YNE-YNW) 600 CONTINUE C****** CONNECT HEAD AND TAILS OF CONTOUR VECTORS ****************** C ONE=1.0 IF(FSM(I,J).LT.ONE.OR.FSM(I,J+1).LT.ONE) X1=S IF(FSM(I,J+1).LT.ONE.OR.FSM(I+1,J+1).LT.ONE) X3=S IF(FSM(I+1,J).LT.ONE.OR.FSM(I+1,J+1).LT.ONE) X5=S IF(FSM(I,J).LT.ONE.OR.FSM(I+1,J).LT.ONE) X7=S IF(X3.EQ.S) GO TO 930 IF(X1.EQ.S) GO TO 910 L=L+1 XF(L)=X1 YF(L)=Y1 XL(L)=X3 YL(L)=Y3 IF(X5.NE.S) GO TO 950 910 IF(X5.EQ.S) GO TO 920 L=L+1 XF(L)=X5 YF(L)=Y5 XL(L)=X3 YL(L)=Y3 920 IF(X7.EQ.S.OR.X5.NE.S.OR.X1.NE.S) GO TO 930 L=L+1 XF(L)=X7 YF(L)=Y7 XL(L)=X3 YL(L)=Y3 930 IF(X1.EQ.S) GO TO 950 IF(X5.EQ.S.OR.X3.NE.S.OR.X7.NE.S) GO TO 940 L=L+1 XF(L)=X1 YF(L)=Y1 XL(L)=X5 YL(L)=Y5 940 IF(X7.EQ.S) GO TO 950 L=L+1 XF(L)=X1 YF(L)=Y1 XL(L)=X7 YL(L)=Y7 950 IF(X5.EQ.S.OR.X7.EQ.S) GO TO 960 L=L+1 XF(L)=X5 YF(L)=Y5 XL(L)=X7 YL(L)=Y7 960 CONTINUE LREM=L IF(LREM.LE.1) GO TO 9999 C****** SORT ASSEMBLAGE OF VECTORS TO FORM CONTOURS *********** 9990 CONTINUE IPASS=1 L=1 XC(1)=XF(L) YC(1)=YF(L) XC(2)=XL(L) YC(2)=YL(L) M=2 C 20 L=L+1 DO 50 LLL=L,LREM XF(LLL-1)=XF(LLL) YF(LLL-1)=YF(LLL) XL(LLL-1)=XL(LLL) YL(LLL-1)=YL(LLL) 50 CONTINUE LREM=LREM-1 60 CONTINUE IF(LREM.LT.1) GO TO 106 DO 105 L=1,LREM IF(XF(L).GT.(XC(M)+EX).OR.XF(L).LT.(XC(M)-EX)) GO TO 100 IF(YF(L).GT.(YC(M)+EY).OR.YF(L).LT.(YC(M)-EY)) GO TO 100 M=M+1 XC(M)=XL(L) YC(M)=YL(L) GO TO 20 100 CONTINUE IF(XL(L).GT.(XC(M)+EX).OR.XL(L).LT.(XC(M)-EX)) GO TO 105 IF(YL(L).GT.(YC(M)+EY).OR.YL(L).LT.(YC(M)-EY)) GO TO 105 M=M+1 XC(M)=XF(L) YC(M)=YF(L) GO TO 20 105 CONTINUE C***** CHECK TO SEE IF CLOSED CURVE ******************************** IF(XC(1).LT.(XC(M)+EX).AND.XC(1).GT.(XC(M)-EX).AND. 1 YC(1).LT.(YC(M)+EY).AND.YC(1).GT.(YC(M)-EY)) GO TO 106 C**** OTHERWISE CURVE TERMINATES ON EDGE; THEN FIND SECOND PIECE *** IF(LREM.GT.2.AND.IPASS.EQ.1) THEN CALL TRANPOS(M,XC,YC) IPASS=2 GO TO 60 ENDIF 106 CONTINUE C**** WEED OUT CLOSELY SPACED POINTS ********************************** ME=M M=1 EXY=100.0*(EX+EY) XCR(1)=XC(1) YCR(1)=YC(1) DO 110 I=2,ME IF(ABS(XC(I)-XC(M)).LT.EXY.AND.ABS(YC(I)-YC(M)).LT.EXY) GO TO 110 M=M+1 XCR(M)=XC(I) YCR(M)=YC(I) 110 CONTINUE C************ CONTOUR COMPLETED **************************************** C DASH: JCRT= lenth/$ ; JSIZE= size of char. in numbered lines C C WRITE(6,'('' CO ='',F10.3,'' L,LREM,M ='',3I10)') CO,L,LREM,M JCRT=5 JSIZE=1 IF(SZ.LE.0.5)JCRT=3 IF(SZ.LE.0.5)JSIZE=0 ICO=INT(CO) IPAT='$$$$$$$$$$$$$$$$' IF (CO.LT.0.0.AND.IND.EQ.0)IPAT='$$''''$$''''$$''''$$''''' IF(NU.EQ.1.AND.K.EQ.K/2*2)WRITE(IPAT,'(A11,I5)')IPAT,ICO C WRITE(6,'('' IPAT ='',A16)')IPAT C IF(NU.EQ.1.AND.CO.EQ.0.)WRITE(IPAT,'(A12,I4)')IPAT,ICO CALL DASHDC(IPAT,JCRT,JSIZE) CALL CURVED(XCR,YCR,M) 9988 IF(LREM.GT.2) GO TO 9990 9999 CONTINUE RETURN END C---------------------------------------------------------------------- SUBROUTINE TRANPOS(M,XC,YC) DIMENSION XC(1000),YC(1000),XT(1000),YT(1000) DO 100 I=1,M XT(M-I+1)=XC(I) 100 YT(M-I+1)=YC(I) DO 200 I=1,M XC(I)=XT(I) 200 YC(I)=YT(I) RETURN END