diff --git a/DESCRIPTION b/DESCRIPTION index 65fd1a9dd2d8d9f37ec9401dca9ac93d315616be..801097369fda63a394324139b9cf3dacf6df1b31 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: akima -Version: 0.5-6 -Date: 2012-01-06 +Version: 0.5-7 +Date: 2012-01-07 Title: Interpolation of irregularly spaced data Author: Fortran code by H. Akima R port by Albrecht Gebhardt @@ -9,4 +9,4 @@ Author: Fortran code by H. Akima Maintainer: Albrecht Gebhardt Description: Linear or cubic spline interpolation for irregular gridded data License: file LICENSE - +Depends: R (>= 2.0.0) diff --git a/src/akima.new.f b/src/akima.new.f index 9b72cfaca0eb23892706340088c985c0ae324e95..0a91d71fe3d2ab503ee914718b4bb7fe3d4579bf 100644 --- a/src/akima.new.f +++ b/src/akima.new.f @@ -144,16 +144,20 @@ IER = 0 RETURN * Error exit - 20 CONTINUE WRITE (*,FMT=9000) MD,NDP + 20 CONTINUE +C WRITE (*,FMT=9000) MD,NDP IER = 1 RETURN - 30 CONTINUE WRITE (*,FMT=9010) MD,NDP,NDPPV + 30 CONTINUE +C WRITE (*,FMT=9010) MD,NDP,NDPPV IER = 2 RETURN - 40 CONTINUE WRITE (*,FMT=9020) MD,NDP,NIP + 40 CONTINUE +C WRITE (*,FMT=9020) MD,NDP,NIP IER = 3 RETURN - 50 CONTINUE WRITE (*,FMT=9030) + 50 CONTINUE +C WRITE (*,FMT=9030) IER = 9 RETURN * Format statement for error message @@ -324,19 +328,24 @@ IER = 0 RETURN * Error exit - 40 CONTINUE WRITE (*,FMT=9000) MD,NDP + 40 CONTINUE +C WRITE (*,FMT=9000) MD,NDP IER = 1 RETURN - 50 CONTINUE WRITE (*,FMT=9010) MD,NDP,NDPPV + 50 CONTINUE +C WRITE (*,FMT=9010) MD,NDP,NDPPV IER = 2 RETURN - 60 CONTINUE WRITE (*,FMT=9020) MD,NDP,NXI,NYI + 60 CONTINUE +C WRITE (*,FMT=9020) MD,NDP,NXI,NYI IER = 3 RETURN - 70 CONTINUE WRITE (*,FMT=9030) MD,NDP,NXI,NYI + 70 CONTINUE +C WRITE (*,FMT=9030) MD,NDP,NXI,NYI IER = 4 RETURN - 80 CONTINUE WRITE (*,FMT=9040) + 80 CONTINUE +C WRITE (*,FMT=9040) IER = 9 RETURN * Format statement for error message @@ -445,22 +454,27 @@ * Error exit 10 IF (IERTM.EQ.-1) THEN IERT = 1 - CONTINUE WRITE (*,FMT=9000) NDP + CONTINUE +C WRITE (*,FMT=9000) NDP ELSE IF (IERTM.EQ.-2) THEN IERT = 2 - CONTINUE WRITE (*,FMT=9010) + CONTINUE +C WRITE (*,FMT=9010) ELSE IERT = 3 IP1 = IERTM - CONTINUE WRITE (*,FMT=9020) NDP,IP1,XD(IP1),YD(IP1) + CONTINUE +C WRITE (*,FMT=9020) NDP,IP1,XD(IP1),YD(IP1) END IF RETURN 20 IF (IERTL.EQ.1) THEN IERT = 4 - CONTINUE WRITE (*,FMT=9030) NDP + CONTINUE +C WRITE (*,FMT=9030) NDP ELSE IF (IERTL.EQ.2) THEN IERT = 5 - CONTINUE WRITE (*,FMT=9040) + CONTINUE +C WRITE (*,FMT=9040) END IF RETURN * Format statements diff --git a/src/idbvip.f b/src/idbvip.f index d70b7c73fb62c1a6f6a149875939e6536efca589..385ae650834b610c958f3eee0647e05e2e0ea0e3 100644 --- a/src/idbvip.f +++ b/src/idbvip.f @@ -137,7 +137,8 @@ C INTERPOLATES THE ZI VALUES. (FOR MD=1,2,3) 81 CONTINUE RETURN C ERROR EXIT - 90 CONTINUE WRITE (LUN,2090) MD0,NCP0,NDP0,NIP0 + 90 CONTINUE +C WRITE (LUN,2090) MD0,NCP0,NDP0,NIP0 RETURN C FORMAT STATEMENT FOR ERROR MESSAGE 2090 FORMAT(1X/41H *** IMPROPER INPUT PARAMETER VALUE(S)./ diff --git a/src/idcldp.f b/src/idcldp.f index 982410aac1afdc6a6526c95c0ea41f74cf78f236..ceda92c4e726e833aaf3a95013848002a94a7226 100644 --- a/src/idcldp.f +++ b/src/idcldp.f @@ -101,10 +101,13 @@ C - REPLACES THE LOCAL ARRAY FOR THE OUTPUT ARRAY. 59 CONTINUE RETURN C ERROR EXIT - 90 CONTINUE WRITE (LUN,2090) + 90 CONTINUE +C WRITE (LUN,2090) GO TO 92 - 91 CONTINUE WRITE (LUN,2091) - 92 CONTINUE WRITE (LUN,2092) NDP0,NCP0 + 91 CONTINUE +C WRITE (LUN,2091) + 92 CONTINUE +C WRITE (LUN,2092) NDP0,NCP0 IPC(1)=0 RETURN C FORMAT STATEMENTS FOR ERROR MESSAGES diff --git a/src/idsfft.f b/src/idsfft.f index ad8b93aab702f7854699ce5142e7f9f33fe10380..24953c95b474d0859caf6228518304708276a3f1 100644 --- a/src/idsfft.f +++ b/src/idsfft.f @@ -176,7 +176,8 @@ C INTERPOLATES THE ZI VALUES. (FOR MD=1,2,3) 89 CONTINUE RETURN C ERROR EXIT - 90 CONTINUE WRITE (LUN,2090) MD0,NCP0,NDP0,NXI0,NYI0 + 90 CONTINUE +C WRITE (LUN,2090) MD0,NCP0,NDP0,NXI0,NYI0 RETURN C FORMAT STATEMENT FOR ERROR MESSAGE 2090 FORMAT(1X/41H *** IMPROPER INPUT PARAMETER VALUE(S)./ diff --git a/src/idtang.f b/src/idtang.f index 3172ff5805ad7c8132ead455da44d9fbf75f7f91..6ea6ae00463faaa0f4212cf1d25ba49f99589cfb 100644 --- a/src/idtang.f +++ b/src/idtang.f @@ -355,12 +355,16 @@ C ARE LISTED COUNTER-CLOCKWISE. NL=NL0 RETURN C ERROR EXIT - 90 CONTINUE WRITE (LUN,2090) NDP0 + 90 CONTINUE +C WRITE (LUN,2090) NDP0 GO TO 93 - 91 CONTINUE WRITE (LUN,2091) NDP0,IP1,IP2,X1,Y1 + 91 CONTINUE +C WRITE (LUN,2091) NDP0,IP1,IP2,X1,Y1 GO TO 93 - 92 CONTINUE WRITE (LUN,2092) NDP0 - 93 CONTINUE WRITE (LUN,2093) + 92 CONTINUE +C WRITE (LUN,2092) NDP0 + 93 CONTINUE +C WRITE (LUN,2093) NT=0 RETURN C FORMAT STATEMENTS diff --git a/src/tripack.f b/src/tripack.f index d2fbabd0072aa2c8657cc783cad617cb131567a6..4a8fad0aac8218dedf5ac9f06c4abf5118be6815 100644 --- a/src/tripack.f +++ b/src/tripack.f @@ -1609,7 +1609,7 @@ C C Error flag returned by OPTIM. C 25 IER = 5 - CONTINUE WRITE (*,100) NIT, IERR +C WRITE (*,100) NIT, IERR RETURN 100 FORMAT (//5X,'*** Error in OPTIM: NIT = ',I4, . ', IER = ',I1,' ***'/) @@ -2105,7 +2105,7 @@ C Invalid triangulation data structure or collinear nodes C on convex hull boundary. C 33 IER = 3 - CONTINUE WRITE (*,130) IN1, IN2 +C WRITE (*,130) IN1, IN2 130 FORMAT (//5X,'*** Error in EDGE: Invalid triangula', . 'tion or null triangles on boundary'/ . 9X,'IN1 =',I4,', IN2=',I4/) @@ -2114,7 +2114,7 @@ C C Error flag returned by OPTIM. C 34 IER = 4 - CONTINUE WRITE (*,140) NIT, IERR +C WRITE (*,140) NIT, IERR 140 FORMAT (//5X,'*** Error in OPTIM: NIT = ',I4, . ', IER = ',I1,' ***'/) RETURN @@ -4423,7 +4423,7 @@ C C C Print a heading and test for invalid input. C - CONTINUE WRITE (LUN,100) +C WRITE (LUN,100) NL = 1 IF (N .LT. 3 .OR. N .GT. NMAX .OR. . (NROW .NE. 6 .AND. NROW .NE. 9) .OR. @@ -4431,21 +4431,21 @@ C C C Print an error message and bypass the loops. C - CONTINUE WRITE (LUN,110) N, NROW, NT +C WRITE (LUN,110) N, NROW, NT GO TO 3 ENDIF IF (PRNTX) THEN C C Print X and Y. C - CONTINUE WRITE (LUN,101) +C WRITE (LUN,101) NL = 6 DO 1 I = 1,N IF (NL .GE. NLMAX) THEN - CONTINUE WRITE (LUN,106) +C WRITE (LUN,106) NL = 0 ENDIF - CONTINUE WRITE (LUN,102) I, X(I), Y(I) +C WRITE (LUN,102) I, X(I), Y(I) NL = NL + 1 1 CONTINUE ENDIF @@ -4453,21 +4453,21 @@ C C Print the triangulation LTRI. C IF (NL .GT. NLMAX/2) THEN - CONTINUE WRITE (LUN,106) +C WRITE (LUN,106) NL = 0 ENDIF IF (NROW .EQ. 6) THEN - CONTINUE WRITE (LUN,103) +C WRITE (LUN,103) ELSE - CONTINUE WRITE (LUN,104) +C WRITE (LUN,104) ENDIF NL = NL + 5 DO 2 K = 1,NT IF (NL .GE. NLMAX) THEN - CONTINUE WRITE (LUN,106) +C WRITE (LUN,106) NL = 0 ENDIF - CONTINUE WRITE (LUN,105) K, (LTRI(I,K), I = 1,NROW) +C WRITE (LUN,105) K, (LTRI(I,K), I = 1,NROW) NL = NL + 1 2 CONTINUE C @@ -4476,13 +4476,14 @@ C triangles). C NB = 2*N - NT - 2 NA = NT + N - 1 - IF (NL .GT. NLMAX-6) CONTINUE WRITE (LUN,106) - CONTINUE WRITE (LUN,107) NB, NA, NT +C IF (NL .GT. NLMAX-6) WRITE (LUN,106) +C WRITE (LUN,107) NB, NA, NT C C Print NCC and LCT. C - 3 CONTINUE WRITE (LUN,108) NCC - IF (NCC .GT. 0) CONTINUE WRITE (LUN,109) (LCT(I), I = 1,NCC) + 3 CONTINUE +C 3 WRITE (LUN,108) NCC +C IF (NCC .GT. 0) WRITE (LUN,109) (LCT(I), I = 1,NCC) RETURN C C Print formats: @@ -5561,7 +5562,7 @@ C C C Output header comments. C - CONTINUE WRITE (LUN,100,ERR=13) IPX1, IPY1, IPX2, IPY2 +C WRITE (LUN,100,ERR=13) IPX1, IPY1, IPX2, IPY2 100 FORMAT ('%!PS-Adobe-3.0 EPSF-3.0'/ . '%%BoundingBox:',4I4/ . '%%Title: Triangulation'/ @@ -5583,13 +5584,13 @@ C Set the line thickness to 2 points, and draw the C viewport boundary. C T = 2.0 - CONTINUE WRITE (LUN,110,ERR=13) T - CONTINUE WRITE (LUN,120,ERR=13) IPX1, IPY1 - CONTINUE WRITE (LUN,130,ERR=13) IPX1, IPY2 - CONTINUE WRITE (LUN,130,ERR=13) IPX2, IPY2 - CONTINUE WRITE (LUN,130,ERR=13) IPX2, IPY1 - CONTINUE WRITE (LUN,140,ERR=13) - CONTINUE WRITE (LUN,150,ERR=13) +C WRITE (LUN,110,ERR=13) T +C WRITE (LUN,120,ERR=13) IPX1, IPY1 +C WRITE (LUN,130,ERR=13) IPX1, IPY2 +C WRITE (LUN,130,ERR=13) IPX2, IPY2 +C WRITE (LUN,130,ERR=13) IPX2, IPY1 +C WRITE (LUN,140,ERR=13) +C WRITE (LUN,150,ERR=13) 110 FORMAT (F12.6,' setlinewidth') 120 FORMAT (2I4,' moveto') 130 FORMAT (2I4,' lineto') @@ -5602,7 +5603,7 @@ C SFY = DBLE(IH)/DY TX = IPX1 - SFX*WX1 TY = IPY1 - SFY*WY1 - CONTINUE WRITE (LUN,160,ERR=13) TX, TY, SFX, SFY +C WRITE (LUN,160,ERR=13) TX, TY, SFX, SFY 160 FORMAT (2F12.6,' translate'/ . 2F12.6,' scale') C @@ -5611,17 +5612,17 @@ C changed to reflect the new scaling which is applied to C all subsequent output. Set it to 1.0 point. C T = 2.0/(SFX+SFY) - CONTINUE WRITE (LUN,110,ERR=13) T +C WRITE (LUN,110,ERR=13) T C C Save the current graphics state, and set the clip path to C the boundary of the window. C - CONTINUE WRITE (LUN,170,ERR=13) - CONTINUE WRITE (LUN,180,ERR=13) WX1, WY1 - CONTINUE WRITE (LUN,190,ERR=13) WX2, WY1 - CONTINUE WRITE (LUN,190,ERR=13) WX2, WY2 - CONTINUE WRITE (LUN,190,ERR=13) WX1, WY2 - CONTINUE WRITE (LUN,200,ERR=13) +C WRITE (LUN,170,ERR=13) +C WRITE (LUN,180,ERR=13) WX1, WY1 +C WRITE (LUN,190,ERR=13) WX2, WY1 +C WRITE (LUN,190,ERR=13) WX2, WY2 +C WRITE (LUN,190,ERR=13) WX1, WY2 +C WRITE (LUN,200,ERR=13) 170 FORMAT ('gsave') 180 FORMAT (2F12.6,' moveto') 190 FORMAT (2F12.6,' lineto') @@ -5645,7 +5646,7 @@ C C C Add the edge to the path. C - CONTINUE WRITE (LUN,210,ERR=13) X0, Y0, X(N1), Y(N1) +C WRITE (LUN,210,ERR=13) X0, Y0, X(N1), Y(N1) 210 FORMAT (2F12.6,' moveto',2F12.6,' lineto') ENDIF IF (LP .NE. LPL) GO TO 2 @@ -5701,8 +5702,8 @@ C Draw the edge iff (PASS1=TRUE and CNSTR=FALSE) or C (PASS1=FALSE and CNSTR=TRUE); i.e., CNSTR and PASS1 C have opposite values. C - IF (CNSTR .NEQV. PASS1) - . CONTINUE WRITE (LUN,210,ERR=13) X0, Y0, X(N1), Y(N1) +C IF (CNSTR .NEQV. PASS1) +C . WRITE (LUN,210,ERR=13) X0, Y0, X(N1), Y(N1) ENDIF IF (N1 .EQ. N0BAK) CNSTR = .FALSE. C @@ -5720,9 +5721,9 @@ C are applied to everything, the dash length must be C specified in world coordinates. C PASS1 = .FALSE. - CONTINUE WRITE (LUN,150,ERR=13) +C WRITE (LUN,150,ERR=13) T = DASHL*2.0/(SFX+SFY) - CONTINUE WRITE (LUN,220,ERR=13) T +C WRITE (LUN,220,ERR=13) T 220 FORMAT ('[',F12.6,'] 0 setdash') GO TO 4 ENDIF @@ -5730,8 +5731,8 @@ C C Paint the path and restore the saved graphics state (with C no clip path). C - CONTINUE WRITE (LUN,150,ERR=13) - CONTINUE WRITE (LUN,230,ERR=13) +C WRITE (LUN,150,ERR=13) +C WRITE (LUN,230,ERR=13) 230 FORMAT ('grestore') IF (NUMBR) THEN C @@ -5740,7 +5741,7 @@ C Convert FSIZN from points to world coordinates, and C output the commands to select a font and scale it. C T = FSIZN*2.0/(SFX+SFY) - CONTINUE WRITE (LUN,240,ERR=13) T +C WRITE (LUN,240,ERR=13) T 240 FORMAT ('/Helvetica findfont'/ . F12.6,' scalefont setfont') C @@ -5756,8 +5757,8 @@ C Move to (X0,Y0), and draw the label N0. The first char- C acter will have its lower left corner about one C character width to the right of the nodal position. C - CONTINUE WRITE (LUN,180,ERR=13) X0, Y0 - CONTINUE WRITE (LUN,250,ERR=13) N0 +C WRITE (LUN,180,ERR=13) X0, Y0 +C WRITE (LUN,250,ERR=13) N0 250 FORMAT ('(',I3,') show') 9 CONTINUE ENDIF @@ -5766,15 +5767,15 @@ C Convert FSIZT from points to world coordinates, and output C the commands to select a font and scale it. C T = FSIZT*2.0/(SFX+SFY) - CONTINUE WRITE (LUN,240,ERR=13) T +C WRITE (LUN,240,ERR=13) T C C Display TITLE centered above the plot: C Y0 = WY2 + 3.0*T - CONTINUE WRITE (LUN,260,ERR=13) TITLE, (WX1+WX2)/2.0, Y0 +C WRITE (LUN,260,ERR=13) TITLE, (WX1+WX2)/2.0, Y0 260 FORMAT (A80/' stringwidth pop 2 div neg ',F12.6, . ' add ',F12.6,' moveto') - CONTINUE WRITE (LUN,270,ERR=13) TITLE +C WRITE (LUN,270,ERR=13) TITLE 270 FORMAT (A80/' show') IF (ANNOT) THEN C @@ -5782,10 +5783,10 @@ C Display the window extrema below the plot. C X0 = WX1 Y0 = WY1 - 100.0/(SFX+SFY) - CONTINUE WRITE (LUN,180,ERR=13) X0, Y0 - CONTINUE WRITE (LUN,280,ERR=13) WX1, WX2 +C WRITE (LUN,180,ERR=13) X0, Y0 +C WRITE (LUN,280,ERR=13) WX1, WX2 Y0 = Y0 - 2.0*T - CONTINUE WRITE (LUN,290,ERR=13) X0, Y0, WY1, WY2 +C WRITE (LUN,290,ERR=13) X0, Y0, WY1, WY2 280 FORMAT ('(Window: WX1 = ',E9.3,', WX2 = ',E9.3, . ') show') 290 FORMAT ('(Window: ) stringwidth pop ',F12.6,' add', @@ -5796,7 +5797,7 @@ C C Paint the path and output the showpage command and C end-of-file indicator. C - CONTINUE WRITE (LUN,300,ERR=13) +C WRITE (LUN,300,ERR=13) 300 FORMAT ('stroke'/ . 'showpage'/ . '%%EOF') @@ -5805,7 +5806,7 @@ C HP's interpreters require a one-byte End-of-PostScript-Job C indicator (to eliminate a timeout error message): C ASCII 4. C - CONTINUE WRITE (LUN,310,ERR=13) CHAR(4) +C WRITE (LUN,310,ERR=13) CHAR(4) 310 FORMAT (A1) C C No error encountered. @@ -5895,12 +5896,12 @@ C C C Print a heading and test the range of N. C - CONTINUE WRITE (LUN,100) NN +C WRITE (LUN,100) NN IF (NN .LT. 3 .OR. NN .GT. NMAX) THEN C C N is outside its valid range. C - CONTINUE WRITE (LUN,110) +C WRITE (LUN,110) GO TO 5 ENDIF C @@ -5914,7 +5915,7 @@ C C Print LIST only. K is the number of neighbors of NODE C which are stored in NABOR. C - CONTINUE WRITE (LUN,101) +C WRITE (LUN,101) DO 2 NODE = 1,NN LPL = LEND(NODE) LP = LPL @@ -5942,17 +5943,17 @@ C INC = (K-1)/14 + 2 NL = NL + INC IF (NL .GT. NLMAX) THEN - CONTINUE WRITE (LUN,106) +C WRITE (LUN,106) NL = INC ENDIF - CONTINUE WRITE (LUN,103) NODE, (NABOR(I), I = 1,K) - IF (K .NE. 14) CONTINUE WRITE (LUN,105) +C WRITE (LUN,103) NODE, (NABOR(I), I = 1,K) +C IF (K .NE. 14) WRITE (LUN,105) 2 CONTINUE ELSE C C Print X, Y, and LIST. C - CONTINUE WRITE (LUN,102) +C WRITE (LUN,102) DO 4 NODE = 1,NN LPL = LEND(NODE) LP = LPL @@ -5977,12 +5978,12 @@ C INC = (K-1)/8 + 2 NL = NL + INC IF (NL .GT. NLMAX) THEN - CONTINUE WRITE (LUN,106) +C WRITE (LUN,106) NL = INC ENDIF - CONTINUE WRITE (LUN,104) NODE, X(NODE), Y(NODE), +C WRITE (LUN,104) NODE, X(NODE), Y(NODE), . (NABOR(I), I = 1,K) - IF (K .NE. 8) CONTINUE WRITE (LUN,105) +C IF (K .NE. 8) WRITE (LUN,105) 4 CONTINUE ENDIF C @@ -5991,13 +5992,14 @@ C triangles). C NT = 2*NN - NB - 2 NA = NT + NN - 1 - IF (NL .GT. NLMAX-6) CONTINUE WRITE (LUN,106) - CONTINUE WRITE (LUN,107) NB, NA, NT +C IF (NL .GT. NLMAX-6) WRITE (LUN,106) +C WRITE (LUN,107) NB, NA, NT C C Print NCC and LCC. C - 5 CONTINUE WRITE (LUN,108) NCC - IF (NCC .GT. 0) CONTINUE WRITE (LUN,109) (LCC(I), I = 1,NCC) + 5 CONTINUE +C WRITE (LUN,108) NCC +C IF (NCC .GT. 0) WRITE (LUN,109) (LCC(I), I = 1,NCC) RETURN C C Print formats: diff --git a/src/ttidbs.f b/src/ttidbs.f index 5923ffe8556ec17f7d8c33e00cbfef836261fa30..7d594d8544446731b90359e456f9b72e010c126f 100644 --- a/src/ttidbs.f +++ b/src/ttidbs.f @@ -79,33 +79,33 @@ C CALCULATION ID000670 16 CONTINUE ID000810 17 CONTINUE ID000820 C PRINTING OF INPUT DATA ID000830 - 20 CONTINUE WRITE (LUN,2020) NDP ID000840 +C WRITE (LUN,2020) NDP ID000840 DO 23 IDP=1,NDP ID000850 - IF(MOD(IDP,5).EQ.1) CONTINUE WRITE (LUN,2021) ID000860 - CONTINUE WRITE (LUN,2022) IDP,XD(IDP),YD(IDP),ZD(IDP) ID000870 +C WRITE (LUN,2021) ID000860 +C WRITE (LUN,2022) IDP,XD(IDP),YD(IDP),ZD(IDP) ID000870 23 CONTINUE ID000880 C PRINTING OF OUTPUT RESULTS ID000890 - 30 CONTINUE WRITE (LUN,2030) ID000900 - CONTINUE WRITE (LUN,2031) YI ID000910 +C WRITE (LUN,2030) ID000900 +C WRITE (LUN,2031) YI ID000910 DO 33 IXI=1,NXI ID000920 - CONTINUE WRITE (LUN,2032) XI(IXI),(ZI1(IXI,IYI),IYI=1,NYI) ID000930 +C WRITE (LUN,2032) XI(IXI),(ZI1(IXI,IYI),IYI=1,NYI) ID000930 33 CONTINUE ID000940 - 40 CONTINUE WRITE (LUN,2040) ID000950 - CONTINUE WRITE (LUN,2031) YI ID000960 +C WRITE (LUN,2040) ID000950 +C WRITE (LUN,2031) YI ID000960 DO 43 IXI=1,NXI ID000970 - CONTINUE WRITE (LUN,2032) XI(IXI),(DZI1(IXI,IYI),IYI=1,NYI) ID000980 +C WRITE (LUN,2032) XI(IXI),(DZI1(IXI,IYI),IYI=1,NYI) ID000980 43 CONTINUE ID000990 - 50 CONTINUE WRITE (LUN,2050) ID001000 - CONTINUE WRITE (LUN,2031) YI ID001010 +C WRITE (LUN,2050) ID001000 +C WRITE (LUN,2031) YI ID001010 DO 53 IXI=1,NXI ID001020 - CONTINUE WRITE (LUN,2032) XI(IXI),(ZI2(IXI,IYI),IYI=1,NYI) ID001030 +C WRITE (LUN,2032) XI(IXI),(ZI2(IXI,IYI),IYI=1,NYI) ID001030 53 CONTINUE ID001040 - 60 CONTINUE WRITE (LUN,2060) ID001050 - CONTINUE WRITE (LUN,2031) YI ID001060 +C WRITE (LUN,2060) ID001050 +C WRITE (LUN,2031) YI ID001060 DO 63 IXI=1,NXI ID001070 - CONTINUE WRITE (LUN,2032) XI(IXI),(DZI2(IXI,IYI),IYI=1,NYI) ID001080 +C WRITE (LUN,2032) XI(IXI),(DZI2(IXI,IYI),IYI=1,NYI) ID001080 63 CONTINUE ID001090 - STOP ID001100 +C STOP ID001100 C FORMAT STATEMENTS ID001110 2020 FORMAT(1H1,6HTTIDBS/////3X,10HINPUT DATA,8X,5HNDP =,I3/// ID001120 1 30H I XD YD ZD /) ID001130