*DK N2MAIN                                                                  MAIN.1
      SUBROUTINE N2MAIN(LEVEL,MTER,ASTEP)                                   MAIN.2
      INCLUDE 'n2param.h'                                                   MAIN.3
      INCLUDE 'n2array.h'                                                   MAIN.4
      INCLUDE 'nestcnt.h'                                                   MAIN.5
      INCLUDE 'n2const.h'                                                   MAIN.6
      INCLUDE 'start.h'                                                     MAIN.7
      COMMON/N2INI/INITIAL,INIINPUT                                         MAIN.8
C     ****                                                                  MAIN.9
C     ****     INITIALIZATION OF THE NESTED GRID DOMAIN                     MAIN.10
C     ****                                                                  MAIN.11
      IF(INITIAL.EQ.0)THEN                                                  MAIN.12
C      ****                                                                 MAIN.13
C      ****     SPECIFY NESTED GRID PARAMETERS                              MAIN.14
C      ****                                                                 MAIN.15
       CALL N2CON(LEVEL,ASTEP)                                              MAIN.16
C      ****                                                                 MAIN.17
C      ****     SPECIFY MAGNETIC FIELDS                                     MAIN.18
C      ****                                                                 MAIN.19
       CALL N2MAGFIELD(LEVEL)                                               MAIN.20
       INITIAL=1                                                            MAIN.21
      ENDIF                                                                 MAIN.22
C     ****                                                                  MAIN.23
C     ****     INTERPOLATE COARSE GRID BOUNDARY VALUES TO THE NESTED        MAIN.24
C     ****     GRID DOMAIN                                                  MAIN.25
C     ****                                                                  MAIN.26
      CALL N2CSTOFN                                                         MAIN.27
      CALL N2IONDRIFT(LEVEL)                                                MAIN.28
C     ****                                                                  MAIN.29
C     ****     ADVANCE NESTED GRID SIMULATION BY ONE TIME STEP              MAIN.30
C     ****                                                                  MAIN.31
      CALL N2ADVNCE(MTER,LEVEL)                                             MAIN.32
      RETURN                                                                MAIN.33
      END                                                                   MAIN.34
C                                                                           MAIN.35
*DK ADVNCE                                                                ADVNCE.1
      SUBROUTINE N2ADVNCE(MTER,LEVEL)                                     ADVNCE.2
C     ****                                                                ADVNCE.3
C     ****     ADVANCES THE MODEL IN TIME                                 ADVNCE.4
C     ****                                                                ADVNCE.5
      INCLUDE 'n2param.h'                                                 ADVNCE.6
      INCLUDE 'n2cvscr.h'                                                 ADVNCE.7
      INCLUDE 'buffe.h'                                                   ADVNCE.8
      INCLUDE 'n2array.h'                                                 ADVNCE.9
      INCLUDE 'n2const.h'                                                 ADVNCE.10
      INCLUDE 'index.h'                                                   ADVNCE.11
      INCLUDE 'start.h'                                                   ADVNCE.12
      INCLUDE 'n2phycs.h'                                                 ADVNCE.13
      INCLUDE 'nestcnt.h'                                                 ADVNCE.14
      WRITE(6,5)MTER                                                      ADVNCE.15
    5 FORMAT(1H0,17X,'ADVANCE ENTERED AT MTER ',I6)                       ADVNCE.16
C     ****                                                                ADVNCE.17
C     ****     INITIALIZE BUFFER INDICES                                  ADVNCE.18
C     ****                                                                ADVNCE.19
      MODULO=8                                                            ADVNCE.20
      CALL INIT                                                           ADVNCE.21
C     ****                                                                ADVNCE.22
C     ****     TIME LOOP                                                  ADVNCE.23
C     ****                                                                ADVNCE.24
      NTER=MTER*NESTRI(LEVEL)                                             ADVNCE.25
      NTIME=0                                                             ADVNCE.26
  100 CONTINUE                                                            ADVNCE.27
      NTIME=NTIME+1                                                       ADVNCE.28
      NTER=NTER+1                                                         ADVNCE.29
C     ****                                                                ADVNCE.30
C     ****     FIND UT TIME  (MODEL DAY = UT DAY, 11/89)                  ADVNCE.31
C     ****                                                                ADVNCE.32
      SECS=DBLE(NTER)*C(4)                                                ADVNCE.33
      CALL TAIL(SECS)                                                     ADVNCE.34
C     ****                                                                ADVNCE.35
C     ****     BEGIN SWEEP OF MESH FROM SOUTH TO NORTH                    ADVNCE.36
C     ****     BRING IN LINE 1                                            ADVNCE.37
C     ****                                                                ADVNCE.38
c      CALL N1VDRIFT                                                       ADVNCE.39
      CALL FLIP                                                           ADVNCE.40
c      READ(NESTIN(LEVEL))(F(I,NJIN),I=1,IMX*IFLDX)                        ADVNCE.43
      DO I=1,IMAX*(KMAXP1*NHIST+1)                                        ADVNCE.41
       F(I,NJIN)=G(I,1,1)                                                 ADVNCE.42
      ENDDO                                                               ADVNCE.43
C     ****     BRING IN LINES 2 AND 3                                     ADVNCE.45
C     ****     AND REARRANGE LINES 1 AND 2                                ADVNCE.46
C     ****     TO FORM LINES 0 AND -1                                     ADVNCE.47
C     ****                                                                ADVNCE.48
      DO JP2=1,2                                                          ADVNCE.113
       CALL FLIP                                                          ADVNCE.114
       DO I=1,IMAX*(KMAXP1*NHIST+1)                                       ADVNCE.51
        F(I,NJIN)=G(I,1,JP2+1)                                            ADVNCE.52
       ENDDO                                                              ADVNCE.53
C      ****                                                               ADVNCE.54
C      ****     ADD DIAGNOSTIC QUANTITIES ONTO LINE JP2                   ADVNCE.55
C      ****                                                               ADVNCE.56
       J=JP2-2                                                            ADVNCE.57
c       CALL N1ADDIAG(NTER)                                                ADVNCE.58
      ENDDO
C     ****                                                                ADVNCE.60
C     ****     GENERAL LINE LOOP (LATITUDINAL VARIATION)                  ADVNCE.61
C     ****                                                                ADVNCE.62
      DO 3000 J=1,JMAX                                                    ADVNCE.63
      write(6,*)j
      RACS=1./(C(51)*CS(J))                                               ADVNCE.64
      CALL FLIP                                                           ADVNCE.65
C     ****                                                                ADVNCE.66
C     ****     START IN NEXT LINE NORTH                                   ADVNCE.67
C     ****                                                                ADVNCE.68
      IF(J.LT.JMAXM2) THEN                                                ADVNCE.69
       DO I=1,IMAX*(KMAXP1*NHIST+1)                                       ADVNCE.70
        F(I,NJIN)=G(I,1,J+3)                                              ADVNCE.71
       ENDDO                                                              ADVNCE.72
      END IF                                                              ADVNCE.73
C     ****                                                                ADVNCE.74
C     ****     START OUT PREVIOUS LINE SOUTH                              ADVNCE.75
C     ****                                                                ADVNCE.76
      IF(J.NE.1)THEN                                                      ADVNCE.77
       DO I=1,IMAX*(KMAXP1*NHIST+1)                                       ADVNCE.78
        G(I,1,J-1)=F(I,NJOT)                                              ADVNCE.79
       ENDDO                                                              ADVNCE.80
      ENDIF                                                               ADVNCE.81
C     ****                                                                ADVNCE.82
C     ****     ADD DIAGNOSTIC QUANTITIES ONTO LINE J+2                    ADVNCE.83
C     ****                                                                ADVNCE.84
c      IF(J.LE.JMAXM2)CALL N1ADDIAG(NTER)                                  ADVNCE.85
      IF(J.EQ.JMAX) IFRST=1                                               ADVNCE.86
C     ******************************************************************  ADVNCE.87
C     ****                                                                ADVNCE.88
C     ****                   DYNAMICS                                     ADVNCE.89
C     ****                                                                ADVNCE.90
C     ******************************************************************  ADVNCE.91
C     ****                                                                ADVNCE.92
C     ****     FOR J=1 AND JMAX USE BOUNDARY CONDITIONS                   ADVNCE.93
C     ****                                                                ADVNCE.94
C     ******************************************************************  ADVNCE.386
C     ****                                                                ADVNCE.387
C     ****                   END OF DYNAMICS                              ADVNCE.388
C     ****                                                                ADVNCE.389
C     ******************************************************************  ADVNCE.390
C     ****                                                                ADVNCE.460
C     ****                   SPECIFY NESTED GRID BOUNDARy VALUES          ADVNCE.461
C     ****                                                                ADVNCE.462
3001  CONTINUE
c      NTERN=NTER-1
c      IF(NEST.EQ.1.AND.NTERN.GE.NES(2).AND.NTERN.LE.NEE(2))THEN
c       CALL N2BNDRY(J)
c       IF(J.GE.NESTJ1(2).AND.J.LE.NESTJM(2))THEN
c        CALL N2VIINTER(2)
c       ENDIF
c      ENDIF
 3000 CONTINUE                                                            ADVNCE.459
C     ****                                                                ADVNCE.460
C     ****                   TRANSFER LINE JMAX TO DISK                   ADVNCE.461
C     ****                                                                ADVNCE.462
      CALL FLIP                                                           ADVNCE.463
      DO I=1,IMAX*(KMAXP1*NHIST+1)                                        ADVNCE.464
       G(I,1,J-1)=F(I,NJOT)                                               ADVNCE.465
      ENDDO                                                               ADVNCE.466
      IF(NTIME.LT.NESTRI(LEVEL)) GO TO 100                                ADVNCE.340
      RETURN                                                              ADVNCE.484
      END                                                                 ADVNCE.485
C                                                                         ADVNCE.486
*DK                                                                       BLOCKD.1
      BLOCK DATA N2CONSTS                                                 BLOCKD.2
      INCLUDE 'n2param.h'                                                 BLOCKD.3
      INCLUDE 'n2const.h'                                                 BLOCKD.4
      COMMON/N2INI/INITIAL,INIINPUT                                       BLOCKD.5
      REAL*8 NOB                                                           CMPNO.13
      COMMON/N2RUNT/TTBOUND,NOB(JMX),AVTO,HOR(JMX)                          CMPNO.14
      DATA INITIAL/0/,INIINPUT/0/                                                    BLOCKD.6
      DATA RMASS/32.,16.,28./                                               CON.14
      DATA CI/(0.0,1.0)/
C     ****                                                                RUNMDS.11
C     ****     VALUE OF T AT LOWER BOUNDARY                               RUNMDS.12
C     ****                                                                RUNMDS.13
      DATA TTBOUND/181./                                                  RUNMDS.14
C     ****                                                                RUNMDS.19
C     ****     N(NO) AT LOWER BOUNDARY, A FUNCTION OF LATITUDE            RUNMDS.20
C     ****       -- 36 VALUES                                             RUNMDS.21
C     ****                                                                RUNMDS.22
      DATA NOB/JMX*4.D6/                                                  RUNMDS.23
C     ****                                                                RUNMDS.24
C     ****     SET AVTO                                                   RUNMDS.25
C     ****                                                                RUNMDS.26
      DATA AVTO/1.D-12/                                                   RUNMDS.27
C     ****                                                                RUNMDS.28
C     ****     SET ARRAY GIVING HORIZONTAL VARIATION OF EDDY DIFFUSION    RUNMDS.29
C     ****     AND EDDY THERMAL CONDUCTIVITY.  IF VALUES ARE UNITY,       RUNMDS.30
C     ****     VALUE OF KE AT BOTTOM OF MODEL IS 5.D-6                    RUNMDS.31
C     ****                                                                RUNMDS.32
      DATA HOR/JMX*.5/                                                    RUNMDS.33
      END                                                                 BLOCKD.13
C                                                                         BLOCKD.14
*DK CON                                                                      CON.1
      SUBROUTINE N2CON(NLEVEL,ASTEP)                                         CON.2
C     ****                                                                   CON.3
C     ****                   DEFINES THE MODEL CONSTANTS                     CON.4
C     ****                                                                   CON.5
      INCLUDE 'n2param.h'                                                    CON.6
      INCLUDE 'n2const.h'                                                    CON.7
      INCLUDE 'nestcnt.h'                                                    CON.9
      INCLUDE 'start.h'                                                      CON.10
      COMMON/C6/C61,C62                                                      CON.11
C     ****                                                                   CON.12
C     ****                   RESOLUTION PARAMETERS                           CON.13
C     ****                                                                   CON.14
      IMAX=IMX                                                               CON.15
      JMAX=JMX                                                               CON.16
      KMAX=KMX                                                               CON.17
      IMAXX=72                                                               CON.18
      JMAXX=36                                                               CON.19
C     ****                                                                   CON.20
C     ****                   DERIVED CONSTANTS                               CON.21
C     ****                                                                   CON.22
      PI=3.14159265358979                                                    CON.23
      DLAMDA=2.*PI/FLOAT(IMAXX)                                              CON.24
      DPHI=PI/FLOAT(JMAXX)                                                   CON.25
      RATIO=1                                                                CON.26
      DO N=1,NLEVEL                                                          CON.27
       RATIO=RATIO*DBLE(NESTRI(N))                                           CON.28
      ENDDO                                                                  CON.29
      DLAMDA=DLAMDA/RATIO                                                    CON.30
      DPHI=DPHI/RATIO                                                        CON.31
      DS=(ST-SB)/FLOAT(KMAX)                                                 CON.32
      JMAXM1=JMAX-1                                                          CON.33
      JMAXM2=JMAX-2                                                          CON.34
      KMAXM1=KMAX-1                                                          CON.35
      KMAXP1=KMAX+1                                                          CON.36
C     **** 								     CON.37
C     ****                   BUFFER INFORMATION                              CON.38
C     ****                   COMPUTE NUMBER OF FIELDS ON TAPE                CON.39
C     ****                   AND INITIALIZE POINTERS                         CON.40
C     ****                                                                   CON.41
      LEN1=IMAX                                                              CON.42
      LEN2=IMAX*KMAX                                                         CON.43
      LEN3=IMAX*KMAXP1                                                       CON.44
C     ****                                                                   CON.45
C     ****                  COMPUTE PHI VARIATION ARRAYS                     CON.46
C     ****                                                                   CON.47
      OMEGA=7.292E-5                                                         CON.48
      DO J=1,JMAX                                                            CON.49
       PHI=PHIS(2)*PI/180.+FLOAT(J-1)*DPHI                                   CON.50
       CS(J)=DCOS(PHI)                                                       CON.51
       SN(J)=DSIN(PHI)                                                       CON.52
       TN(J)=DTAN(PHI)                                                       CON.53
       COR(J)=2.*OMEGA*SN(J)                                                 CON.54
      ENDDO                                                                  CON.55
C     ****                                                                   CON.56
C     ****     CALCULATE SUN'S DECLINATION                                   CON.57
C     ****                                                                   CON.58
      DELTA=DATAN(DTAN(23.5*PI/180.)*DSIN(2.*PI*DBLE(IIDAY-80)/365.))        CON.59
C     ****                                                                   CON.60
C     ****                   GRID CONSTANTS                                  CON.61
C     ****                                                                   CON.62
      C(1)=DLAMDA                                                            CON.63
      C(2)=DPHI                                                              CON.64
      C(3)=DS                                                                CON.65
      C(4)=ASTEP/DBLE(NESTRI(NLEVEL))                                        CON.66
      C(6)=2.*C(4)                                                           CON.67
      C(7)=1./C(6)                                                           CON.68
C     ****                                                                   CON.69
C     ****                   FINITE DIFFERENCE OPERATOR CONSTANTS            CON.70
C     ****                                                                   CON.71
      C(10)=2./(3.*DLAMDA)                                                   CON.72
      C(11)=1./(12.*DLAMDA)                                                  CON.72
      C(12)=2./(3.*DPHI)                                                     CON.73
      C(13)=1./(12.*DPHI)                                                    CON.74
      C(14)=1./(2.*DLAMDA)                                                   CON.75
      C(15)=1./(2.*DPHI)                                                     CON.76
C     ****                                                                   CON.77
C     ****     INTEGRATION CONSTANTS                                         CON.78
C     ****                                                                   CON.79
      C(18)=C(3)/(1.+.5*C(3))                                                CON.80
      C(19)=(1.-.5*C(3))/(1.+.5*C(3))                                        CON.81
      C(20)=1./DS                                                            CON.82
      C(22)=DCOS(PI/3.)                                                      CON.83
      C(23)=4.*PI/(24.*60.*60.)                                              CON.84
      C(24)=28.9                                                             CON.85
C     ****                                                                   CON.86
C     ****     ANNUAL FREQUENCY                                              CON.87
C     ****                                                                   CON.88
      C(25)=C(23)/(2.*365.25)                                                CON.89
C     ****                                                                   CON.90
C     ****     SHAPIRO SMOOTHER CONSTANT                                     CON.91
C     ****                                                                   CON.92
      C(26)=3.0D-2                                                           CON.93
C     ****                                                                   CON.94
C     ****     EDDY DIFFUSION                                                CON.95
C     ****                                                                   CON.96
      C(27)=5.D-6                                                            CON.97
C     ****                                                                   CON.98
C     ****     EDDY THERMAL CONDUCTION                                       CON.99
C     ****                                                                   CON.100
      C(28)=C(27)                                                            CON.101
C     ****                                                                   CON.102
C     ****                   TIME SMOOTHING CONSTANT                         CON.103
C     ****                                                                   CON.104
      ALPHA=.95                                                              CON.105
      C(30)=ALPHA                                                            CON.106
      C(31)=.5*(1.-ALPHA)                                                    CON.107
C     ****                                                                   CON.108
C     ****     SURPLUS HEAT PER EVENT CONVERTED FROM E.V. TO ERGS            CON.109
C     ****                                                                   CON.110
      C(45)=5.11*1.602D-12                                                   CON.111
C     ****                                                                   CON.112
C     ****                   PHYSICAL CONSTANTS                              CON.113
C     ****                                                                   CON.114
C    ****                        EARTHS RADIUS                               CON.115
C     ****                                                                   CON.116
      C(51)=6.37122E8                                                        CON.117
      C(52)=1./C(51)                                                         CON.118
      C(53)=C(51)*C(51)                                                      CON.119
C     ****                                                                   CON.120
C                                 GRAVITATIONAL CONSTANT                     CON.121
C     ****                                                                   CON.122
      C(54)=870.                                                             CON.123
      C(55)=1./C(54)                                                         CON.124
C     ****                                                                   CON.125
C                                 EARTHS ANGULAR VELOCITY                    CON.126
C     ****                                                                   CON.127
      C(56)=OMEGA                                                            CON.128
C     ****                                                                   CON.129
C                                 GAS CONSTANT                               CON.130
C     ****                                                                   CON.131
      C(57)=8.314D7                                                          CON.132
C     ****                                                                   CON.133
C     ****     H*C                                                           CON.134
C     ****                                                                   CON.135
      C(60)=1.9845D-16                                                       CON.136
C     ****                                                                   CON.137
C     ****     F10.7                                                         CON.138
C     ****                                                                   CON.139
      C(61)=C61                                                              CON.140
      C(62)=C62                                                              CON.141
C     ****                                                                   CON.142
C     ****                        G/R                                        CON.143
C     ****                                                                   CON.144
      C(65)=C(54)/C(57)                                                      CON.145
C     ****                                                                   CON.146
C     ****     STANDARD PRESSURE                                             CON.147
C     ****                                                                   CON.148
      C(81)=5.0D-4                                                           CON.149
C     ****                                                                   CON.150
C     ****     BOLTZMANN CONST                                               CON.151
C     ****                                                                   CON.152
      C(84)=1.38D-16                                                         CON.153
C     ****                                                                   CON.154
C     ****     AVOGRADO NUMBER                                               CON.155
C     ****                                                                   CON.156
      C(85)=6.023D23                                                         CON.157
C     ****                                                                   CON.158
C     ****     EXP(-.5*DS)                                                   CON.159
C     ****                                                                   CON.160
      C(86)=DEXP(-.5*DS)                                                     CON.161
C     ****                                                                   CON.162
C     ****     EXP(.5*DS)                                                    CON.163
C     ****                                                                   CON.164
      C(87)=1./C(86)                                                         CON.165
C     ****                                                                   CON.166
C     ****     SUN'S DECLINATION:                                            CON.167
C     ****                                                                   CON.168
      C(95)=DSIN(DELTA)                                                      CON.169
      C(96)=DCOS(DELTA)                                                      CON.170
C     ****                                                                   CON.171
C     ****                   KO  COEFFICIENT OF EDDY VISCOSITY               CON.172
C     ****                                                                   CON.173
      C(109)=0.2                                                             CON.174
      C(110)=PI                                                              CON.175
C     ****                                                                   CON.176
C     ****         SAVE ORIGINAL DT VALUE                                    CON.177
C     ****                                                                   CON.178
      C(112)=DSQRT(PI)                                                       CON.179
C     ****                                                                   CON.180
C     ****     CALCULATE EXPS AND A ARRAYS                                   CON.181
C     ****                                                                   CON.182
      S=SB+.5*DS                                                             CON.183
      EXPS(1)=DEXP(-S)                                                       CON.184
      EXPDS=DEXP(-DS)                                                        CON.185
      DIFK(1)=C(27)                                                          CON.186
      DIFT(1)=C(28)                                                          CON.187
      XMUE(1)=C(27)                                                          CON.188
      DO K=2,KMAX                                                            CON.189
       EXPS(K)=EXPS(K-1)*EXPDS                                               CON.190
       DIFK(K)=DIFK(K-1)*EXPDS                                               CON.191
       DIFT(K)=DIFT(K-1)*EXPDS                                               CON.192
       XMUE(K)=DIFK(K)                                                       CON.193
      ENDDO                                                                  CON.194
      DIFK(KMAXP1)=DIFK(KMAX)*EXPDS                                          CON.195
      DIFT(KMAXP1)=DIFT(KMAX)                                                CON.196
      XMUE(KMAXP1)=DIFK(KMAXP1)                                              CON.197
      RETURN                                                                 CON.198
      END                                                                    CON.200
C                                                                            CON.201
*DK DUMINTER                                                            DUMINTER.1
      SUBROUTINE N2DUMINTER(W,J1,JM,LEVEL)                              DUMINTER.2
C     ****                                                              DUMINTER.3
C     ****     INTERPOLATION OF FIELDS OF MAGNETIC FIELD                DUMINTER.4
C     ****     FOR NESTED GRIDS                                         DUMINTER.5
C     ****                                                              DUMINTER.6
      INCLUDE 'n1param.h'                                               DUMINTER.7
      INCLUDE 'n1const.h'                                               DUMINTER.8
      INCLUDE 'nestcnt.h'                                               DUMINTER.9
      INCLUDE 'n2nestg.h'                                               DUMINTER.10
      COMMON/N1TRGM/RLATM(IMX,JMX),RLONM(IMX,JMX),DIPMAG(IMX,JMX),      DUMINTER.11
     1              DECMAG(IMX,JMX),SNDEC(IMX,JMX),CSDEC(IMX,JMX),      DUMINTER.12
     2              SN2DEC(IMX,JMX),SNCSDC(IMX,JMX),DUMDUM(JMX,3)       DUMINTER.13
      DIMENSION W(J1:JM,3)                                              DUMINTER.14
      RATIO=NESTRI(LEVEL)                                               DUMINTER.15
      DO K=1,3                                                          DUMINTER.16
       DO J=1,JNX                                                       DUMINTER.17
        IF(J.EQ.1)THEN                                                  DUMINTER.18
         JJ=NESTJ1(LEVEL)+J-1                                           DUMINTER.19
         W(J,K)=DUMDUM(JJ,K)                                            DUMINTER.20
        ELSE                                                            DUMINTER.21
         J2=NESTRI(LEVEL)*(J-1)+1                                       DUMINTER.22
         J1=NESTRI(LEVEL)*(J-2)+1                                       DUMINTER.23
         JJ=NESTJ1(LEVEL)+J-1                                           DUMINTER.24
         W(J2,K)=DUMDUM(JJ,K)                                           DUMINTER.25
         DO L=1,NESTRI(LEVEL)-1                                         DUMINTER.26
          W(J2-L,K)=W(J2,K)-DBLE(L)*(W(J2,K)-W(J1,K))/RATIO             DUMINTER.27
         ENDDO                                                          DUMINTER.28
        ENDIF                                                           DUMINTER.29
       ENDDO                                                            DUMINTER.30
      ENDDO                                                             DUMINTER.31
      RETURN                                                            DUMINTER.32
      END                                                               DUMINTER.33
C                                                                       DUMINTER.34
*DK HISTIN                                                                HISTIN.1
      SUBROUTINE N2HISTIN(LEVEL)                                          HISTIN.2
      INCLUDE 'n2param.h'                                                 HISTIN.3
      INCLUDE 'nestcnt.h'                                                 HISTIN.4
      INCLUDE 'n2const.h'                                                 HISTIN.5
      INCLUDE 'n2array.h'                                                 HISTIN.6
      INCLUDE 'start.h'                                                   HISTIN.7
C     ****                                                                HISTIN.8
C     ****     PERFORM LINEAR INTERPOLATION OF THE COARSE GRID FOR THE    HISTIN.9
C     ****     INITIALIZATION OF THE NESTED GRID                          HISTIN.10
C     ****                                                                HISTIN.11
      CALL N2NESTIN(G,NHIST,LEVEL)                                        HISTIN.12
      RETURN                                                              HISTIN.13
      END                                                                 HISTIN.14
C                                                                         HISTIN.15
*DK MAGFIELD                                                            MAGFIELD.1
      SUBROUTINE N2MAGFIELD(LEVEL)                                      MAGFIELD.2
C     ****                                                              MAGFIELD.3
C     ****     SET UP VERSIONS OF /TRGM/ AND /MAGFLD/ CALCULATED        MAGFIELD.4
C     ****       FROM TRUE FIELD AVAILABLE IN /FIELD/                   MAGFIELD.5
C     ****                                                              MAGFIELD.6
      INCLUDE 'n2param.h'                                               MAGFIELD.7
      INCLUDE 'n2const.h'                                               MAGFIELD.8
      INCLUDE 'n2nestg.h'                                               MAGFIELD.9
      INCLUDE 'nestcnt.h'                                               MAGFIELD.10
      COMMON/N2MAGFLD/BX(IMX,JMX),BY(IMX,JMX),BZ(IMX,JMX),              MAGFIELD.11
     1                BMOD2(IMX,JMX)                                    MAGFIELD.12
      COMMON/N2TRGM/RLATM(IMX,JMX),RLONM(IMX,JMX),DIPMAG(IMX,JMX),      MAGFIELD.13
     1              DECMAG(IMX,JMX),SNDEC(IMX,JMX),CSDEC(IMX,JMX),      MAGFIELD.14
     2              SN2DEC(IMX,JMX),SNCSDC(IMX,JMX),DUMDUM(JMX,3)       MAGFIELD.15
      COMMON/N2TRGM1/RLATMR(IMX,JMX),RLONMR(IMX,JMX)                    MAGFIELD.16
C     ****                                                              MAGFIELD.17
C     ****     INTERPOLATE MAGNETIC FIELD PARAMETERS FOR NESTED GRID    MAGFIELD.18
C     ****                                                              MAGFIELD.19
      CALL N2MAGINTER(BX,1,JMX,1,IMX,LEVEL,1)                           MAGFIELD.20
      CALL N2MAGINTER(BY,1,JMX,1,IMX,LEVEL,2)                           MAGFIELD.21
      CALL N2MAGINTER(BZ,1,JMX,1,IMX,LEVEL,3)                           MAGFIELD.22
      CALL N2MAGINTER(BMOD2,1,JMX,1,IMX,LEVEL,4)                        MAGFIELD.23
      CALL N2MAGINTER(RLATM,1,JMX,1,IMX,LEVEL,5)                        MAGFIELD.24
      CALL N2MAGINTER(RLONM,1,JMX,1,IMX,LEVEL,6)                        MAGFIELD.25
      CALL N2MAGINTER(DIPMAG,1,JMX,1,IMX,LEVEL,7)                       MAGFIELD.26
      CALL N2MAGINTER(DECMAG,1,JMX,1,IMX,LEVEL,8)                       MAGFIELD.27
      CALL N2MAGINTER(SNDEC,1,JMX,1,IMX,LEVEL,9)                        MAGFIELD.28
      CALL N2MAGINTER(CSDEC,1,JMX,1,IMX,LEVEL,10)                       MAGFIELD.29
      CALL N2MAGINTER(SN2DEC,1,JMX,1,IMX,LEVEL,11)                      MAGFIELD.30
      CALL N2MAGINTER(SNCSDC,1,JMX,1,IMX,LEVEL,12)                      MAGFIELD.31
      CALL N2MAGINTER(RLATMR,1,JMX,1,IMX,LEVEL,13)                      MAGFIELD.32
      CALL N2MAGINTER(RLATMR,1,JMX,1,IMX,LEVEL,14)                      MAGFIELD.33
C     ****                                                              MAGFIELD.34
C     ****     INTERPOLATE MAGNETIC POLE PARAMETERS FOR NESTED GRID     MAGFIELD.35
C     ****                                                              MAGFIELD.36
      CALL N2DUMINTER(DUMDUM,1,JMX,LEVEL)                               MAGFIELD.37
      RETURN                                                            MAGFIELD.38
      END                                                               MAGFIELD.39
C                                                                       MAGFIELD.40
*DK MAGINTER                                                            MAGINTER.1
      SUBROUTINE N2MAGINTER(W,J1,JM,I1,IM,LEVEL,INDEX)                  MAGINTER.2
C     ****                                                              MAGINTER.3
C     ****     INTERPOLATION OF FIELDS OF MAGNETIC FIELD FOR            MAGINTER.4
C     ****     NESTED GRIDS                                             MAGINTER.5
C     ****                                                              MAGINTER.6
      INCLUDE 'n1param.h'                                               MAGINTER.7
      INCLUDE 'n1const.h'                                               MAGINTER.8
      INCLUDE 'nestcnt.h'                                               MAGINTER.9
      INCLUDE 'n2nestg.h'                                               MAGINTER.10
      COMMON/N1MAGFLD/BX(IMX,JMX),BY(IMX,JMX),BZ(IMX,JMX),              MAGINTER.11
     1                BMOD2(IMX,JMX)                                    MAGINTER.12
      COMMON/N1TRGM/RLATM(IMX,JMX),RLONM(IMX,JMX),DIPMAG(IMX,JMX),      MAGINTER.13
     1              DECMAG(IMX,JMX),SNDEC(IMX,JMX),CSDEC(IMX,JMX),      MAGINTER.14
     2              SN2DEC(IMX,JMX),SNCSDC(IMX,JMX),DUMDUM(JMX,3)       MAGINTER.15
      COMMON/N1TRGM1/RLATMR(IMX,JMX),RLONMR(IMX,JMX)                    MAGINTER.16
      DIMENSION W(I1:IM,J1:JM),S(IMX,JMX)                               MAGINTER.17
C     ****                                                              MAGINTER.18
C     ****     SPECIFY FIELD TO INTERPOLATE                             MAGINTER.19
C     ****                                                              MAGINTER.20
      IF(INDEX.EQ.1)THEN                                                MAGINTER.21
       DO J=1,JMX                                                       MAGINTER.22
        DO I=1,IMX                                                      MAGINTER.23
         S(I,J)=BX(I,J)                                                 MAGINTER.24
        ENDDO                                                           MAGINTER.25
       ENDDO                                                            MAGINTER.26
      ELSE IF(INDEX.EQ.2)THEN                                           MAGINTER.27
       DO J=1,JMX                                                       MAGINTER.28
        DO I=1,IMX                                                      MAGINTER.29
         S(I,J)=BY(I,J)                                                 MAGINTER.30
        ENDDO                                                           MAGINTER.31
       ENDDO                                                            MAGINTER.32
      ELSE IF(INDEX.EQ.3)THEN                                           MAGINTER.33
       DO J=1,JMX                                                       MAGINTER.34
        DO I=1,IMX                                                      MAGINTER.35
         S(I,J)=BZ(I,J)                                                 MAGINTER.36
        ENDDO                                                           MAGINTER.37
       ENDDO                                                            MAGINTER.38
      ELSE IF(INDEX.EQ.4)THEN                                           MAGINTER.39
       DO J=1,JMX                                                       MAGINTER.40
        DO I=1,IMX                                                      MAGINTER.41
         S(I,J)=BMOD2(I,J)                                              MAGINTER.42
        ENDDO                                                           MAGINTER.43
       ENDDO                                                            MAGINTER.44
      ELSE IF(INDEX.EQ.5)THEN                                           MAGINTER.45
       DO J=1,JMX                                                       MAGINTER.46
        DO I=1,IMX                                                      MAGINTER.47
         S(I,J)=RLATM(I,J)                                              MAGINTER.48
        ENDDO                                                           MAGINTER.49
       ENDDO                                                            MAGINTER.50
      ELSE IF(INDEX.EQ.6)THEN                                           MAGINTER.51
       DO J=1,JMX                                                       MAGINTER.52
        DO I=1,IMX                                                      MAGINTER.53
         S(I,J)=RLONM(I,J)                                              MAGINTER.54
        ENDDO                                                           MAGINTER.55
       ENDDO                                                            MAGINTER.56
      ELSE IF(INDEX.EQ.7)THEN                                           MAGINTER.57
       DO J=1,JMX                                                       MAGINTER.58
        DO I=1,IMX                                                      MAGINTER.59
         S(I,J)=DIPMAG(I,J)                                             MAGINTER.60
        ENDDO                                                           MAGINTER.61
       ENDDO                                                            MAGINTER.62
      ELSE IF(INDEX.EQ.8)THEN                                           MAGINTER.63
       DO J=1,JMX                                                       MAGINTER.64
        DO I=1,IMX                                                      MAGINTER.65
         S(I,J)=DECMAG(I,J)                                             MAGINTER.66
        ENDDO                                                           MAGINTER.67
       ENDDO                                                            MAGINTER.68
      ELSE IF(INDEX.EQ.9)THEN                                           MAGINTER.69
       DO J=1,JMX                                                       MAGINTER.70
        DO I=1,IMX                                                      MAGINTER.71
         S(I,J)=SNDEC(I,J)                                              MAGINTER.72
        ENDDO                                                           MAGINTER.73
       ENDDO                                                            MAGINTER.74
      ELSE IF(INDEX.EQ.10)THEN                                          MAGINTER.75
       DO J=1,JMX                                                       MAGINTER.76
        DO I=1,IMX                                                      MAGINTER.77
         S(I,J)=CSDEC(I,J)                                              MAGINTER.78
        ENDDO                                                           MAGINTER.79
       ENDDO                                                            MAGINTER.80
      ELSE IF(INDEX.EQ.11)THEN                                          MAGINTER.81
       DO J=1,JMX                                                       MAGINTER.82
        DO I=1,IMX                                                      MAGINTER.83
         S(I,J)=SN2DEC(I,J)                                             MAGINTER.84
        ENDDO                                                           MAGINTER.85
       ENDDO                                                            MAGINTER.86
      ELSE IF(INDEX.EQ.12)THEN                                          MAGINTER.87
       DO J=1,JMX                                                       MAGINTER.88
        DO I=1,IMX                                                      MAGINTER.89
         S(I,J)=SNCSDC(I,J)                                             MAGINTER.90
        ENDDO                                                           MAGINTER.91
       ENDDO                                                            MAGINTER.92
      ELSE IF(INDEX.EQ.13)THEN                                          MAGINTER.93
       DO J=1,JMX                                                       MAGINTER.94
        DO I=1,IMX                                                      MAGINTER.95
         S(I,J)=RLATMR(I,J)                                             MAGINTER.96
        ENDDO                                                           MAGINTER.97
       ENDDO                                                            MAGINTER.98
      ELSE IF(INDEX.EQ.14)THEN                                          MAGINTER.99
       DO J=1,JMX                                                       MAGINTER.100
        DO I=1,IMX                                                      MAGINTER.101
         S(I,J)=RLONMR(I,J)                                             MAGINTER.102
        ENDDO                                                           MAGINTER.103
       ENDDO                                                            MAGINTER.104
      ENDIF                                                             MAGINTER.105
      RATIO=DBLE(NESTRI(LEVEL))                                         MAGINTER.106
      DO J=1,JNX                                                        MAGINTER.107
C      ****                                                             MAGINTER.108
C      ****     FIRST LINE IN LATITUDE                                  MAGINTER.109
C      ****                                                             MAGINTER.110
       IF(J.EQ.1)THEN                                                   MAGINTER.111
        DO I=1,INX                                                      MAGINTER.112
         II=NESTRI(LEVEL)*(I-1)+1                                       MAGINTER.113
         IC=NESTI1(LEVEL)+I-1                                           MAGINTER.114
         JJ=NESTJ1(LEVEL)+J-1                                           MAGINTER.115
         IF(I.LT.INX)THEN                                               MAGINTER.116
          W(II,J)=S(IC,JJ)                                              MAGINTER.117
          DO L=1,NESTRI(LEVEL)-1                                        MAGINTER.118
           IL=II+L                                                      MAGINTER.119
           W(IL,J)=S(IC,JJ)+DBLE(L)*(S(IC+1,JJ)-S(IC,JJ))/RATIO         MAGINTER.120
          ENDDO                                                         MAGINTER.121
         ELSE                                                           MAGINTER.122
          W(II,J)=S(IC,JJ)                                              MAGINTER.123
         ENDIF                                                          MAGINTER.124
        ENDDO                                                           MAGINTER.125
       ELSE                                                             MAGINTER.126
C       ****                                                            MAGINTER.127
C       ****     NEXT LINE IN LATITUDE                                  MAGINTER.128
C       ****                                                            MAGINTER.129
        JJ=NESTJ1(LEVEL)+J-1                                            MAGINTER.130
        J2=NESTRI(LEVEL)*(J-1)+1                                        MAGINTER.131
        J1=NESTRI(LEVEL)*(J-2)+1                                        MAGINTER.132
        DO I=1,INX                                                      MAGINTER.133
         II=NESTRI(LEVEL)*(I-1)+1                                       MAGINTER.134
         IC=NESTI1(LEVEL)+I-1                                           MAGINTER.135
         IF(I.LT.INX)THEN                                               MAGINTER.136
          W(II,J2)=S(IC,JJ)                                             MAGINTER.137
          DO L=1,NESTRI(LEVEL)-1                                        MAGINTER.138
           IL=II+L                                                      MAGINTER.139
           W(IL,J2)=S(IC,JJ)+DBLE(L)*(S(IC+1,JJ)-S(IC,JJ))/RATIO        MAGINTER.140
          ENDDO                                                         MAGINTER.141
         ELSE                                                           MAGINTER.142
          W(II,J2)=S(IC,JJ)                                             MAGINTER.143
         ENDIF                                                          MAGINTER.144
        ENDDO                                                           MAGINTER.145
C       ****                                                            MAGINTER.146
C       ****     CALCULATE LATITUDINAL LINES IN BETWEEN                 MAGINTER.147
C       ****                                                            MAGINTER.148
        DO I=1,NNX                                                      MAGINTER.149
         DO L=1,NESTRI(LEVEL)-1                                         MAGINTER.150
          W(I,J2-L)=W(I,J2)-DBLE(L)*(W(I,J2)-W(I,J1))/RATIO             MAGINTER.151
         ENDDO                                                          MAGINTER.152
        ENDDO                                                           MAGINTER.153
       ENDIF                                                            MAGINTER.154
      ENDDO                                                             MAGINTER.155
      RETURN                                                            MAGINTER.156
      END                                                               MAGINTER.157
C                                                                       MAGINTER.158
*DK   N2NESTIN                                                            NESTIN.1
      SUBROUTINE N2NESTIN(W,NHIST,NLEVEL)                                 NESTIN.2
      INCLUDE 'n1param.h'                                                 NESTIN.3
      INCLUDE 'n1array.h'                                                 NESTIN.4
      INCLUDE 'nestcnt.h'                                                 NESTIN.5
      INCLUDE 'n2nestg.h'                                                 NESTIN.6
      DIMENSION W(NNX,KMXP*(NHIST+7)+1,NJX)                               NESTIN.7
C     ****                                                                NESTIN.8
C     ****     SPECIFY INITIAL VALUES OF THE NESTED GRID DOMAIN BY        NESTIN.9
C     ****     LINEAR INTERPOLATION OF THE COARSE GRID VALUES             NESTIN.10
C     ****                                                                NESTIN.11
      RATIO=DBLE(NESTRI(NLEVEL))                                          NESTIN.12
      DO K=1,ZKMXP*NHIST+1                                                NESTIN.13
       DO J=1,JNX                                                         NESTIN.14
C       ****                                                              NESTIN.15
C       ****     FIRST LINE IN LATITUDE                                   NESTIN.16
C       ****                                                              NESTIN.17
        IF(J.EQ.1)THEN                                                    NESTIN.18
         DO I=1,INX                                                       NESTIN.19
          II=NESTRI(NLEVEL)*(I-1)+1                                       NESTIN.20
          IC=NESTI1(NLEVEL)+I-1                                           NESTIN.21
          JJ=NESTJ1(NLEVEL)+J-1                                           NESTIN.22
          IF(I.LT.INX)THEN                                                NESTIN.23
           W(II,K,J)=G(IC,K,JJ)                                           NESTIN.24
           DO L=1,NESTRI(NLEVEL)-1                                        NESTIN.25
            IL=II+L                                                       NESTIN.26
            W(IL,K,J)=G(IC,K,JJ)+DBLE(L)*(G(IC+1,K,JJ)-G(IC,K,JJ))/RATIO  NESTIN.27
           ENDDO                                                          NESTIN.28
          ELSE                                                            NESTIN.29
           W(II,K,J)=G(IC,K,JJ)                                           NESTIN.30
          ENDIF                                                           NESTIN.31
         ENDDO                                                            NESTIN.32
        ELSE                                                              NESTIN.33
C        ****                                                             NESTIN.34
C        ****     NEXT LINE IN LATITUDE                                   NESTIN.35
C        ****                                                             NESTIN.36
         J2=NESTRI(NLEVEL)*(J-1)+1                                        NESTIN.37
         J1=NESTRI(NLEVEL)*(J-2)+1                                        NESTIN.38
         JJ=NESTJ1(NLEVEL)+J-1                                            NESTIN.39
         DO I=1,INX                                                       NESTIN.40
          II=NESTRI(NLEVEL)*(I-1)+1                                       NESTIN.41
          IC=NESTI1(NLEVEL)+I-1                                           NESTIN.41
          IF(I.LT.INX)THEN                                                NESTIN.42
           W(II,K,J2)=G(IC,K,JJ)                                          NESTIN.43
           DO L=1,NESTRI(NLEVEL)-1                                        NESTIN.44
            IL=II+L                                                       NESTIN.45
            W(IL,K,J2)=G(IC,K,JJ)+                                        NESTIN.46
     1                 DBLE(L)*(G(IC+1,K,JJ)-G(IC,K,JJ))/RATIO            NESTIN.47
           ENDDO                                                          NESTIN.48
          ELSE                                                            NESTIN.49
           W(II,K,J2)=G(IC,K,JJ)                                          NESTIN.50
          ENDIF                                                           NESTIN.51
         ENDDO                                                            NESTIN.52
C        ****                                                             NESTIN.53
C        ****     CALCULATE LATITUDINAL LINES IN BETWEEN                  NESTIN.54
C        ****                                                             NESTIN.55
         DO I=1,NNX                                                       NESTIN.56
          DO L=1,NESTRI(NLEVEL)-1                                         NESTIN.57
           W(I,K,J2-L)=W(I,K,J2)-DBLE(L)*(W(I,K,J2)-W(I,K,J1))/RATIO      NESTIN.58
          ENDDO                                                           NESTIN.59
         ENDDO                                                            NESTIN.60
        ENDIF                                                             NESTIN.61
       ENDDO                                                              NESTIN.62
      ENDDO                                                               NESTIN.63
      RETURN                                                              NESTIN.64
      END                                                                 NESTIN.65
C                                                                         NESTIN.66
*DK N2TIDE                                                                  TIDE.1
      SUBROUTINE N2TIDE                                                     TIDE.2
      INCLUDE 'n2param.h'                                                   TIDE.3
      INCLUDE 'n2const.h'                                                   TIDE.4
      INCLUDE 'nestcnt.h'                                                   TIDE.5
      INCLUDE 'start.h'                                                     TIDE.6
C     ****                                                                  TIDE.7
C     ****     PERFORM LINEAR INTERPOLATION OF THE TIDE PERTURBATION FOR    TIDE.8
C     ****     THE NESTED GRID                                              TIDE.9
C     ****                                                                  TIDE.10
      LEVEL=2                                                               TIDE.11
      CALL N2TIDEIN(ZB,TB,UB,VB,BND,LEVEL,0)                                TIDE.12
      CALL N2TIDEIN(ZB2,TB2,UB2,VB2,BND2,LEVEL,1)                           TIDE.13
      CALL N2TIDEIN(ZBA,TBA,UBA,VBA,BNDA,LEVEL,2)                           TIDE.14
      RETURN                                                                TIDE.15
      END                                                                   TIDE.16
C                                                                           TIDE.17
*DK TIDEIN                                                                TIDEIN.1
      SUBROUTINE N2TIDEIN(ZP,TP,UP,VP,BP,LEVEL,INDEX)                     TIDEIN.2
C     ****                                                                TIDEIN.3
C     ****     INTERPOLATE TIDE PERTURBATIONS FOR THE USE IN THE NESTED   TIDEIN.4
C     ****     GRID                                                       TIDEIN.5
C     ****                                                                TIDEIN.6
      INCLUDE "n1param.h"                                                 TIDEIN.7
      INCLUDE "n1const.h"                                                 TIDEIN.8
      INCLUDE "n2nestg.h"                                                 TIDEIN.9
      INCLUDE 'nestcnt.h'                                                 TIDEIN.10
      DIMENSION ZP(NJX),TP(NJX),UP(NJX),VP(NJX),BP(NNX)                   TIDEIN.11
      COMPLEX*16 ZP,TP,UP,VP,BP                                           TIDEIN.12
      DIMENSION ZT(NJX),TT(NJX),UT(NJX),VT(NJX),BT(NNX)                   TIDEIN.13
      COMPLEX*16 ZT,TT,UT,VT,BT                                           TIDEIN.14
      IF(INDEX.EQ.0)THEN                                                  TIDEIN.15
       DO J=1,JMAX                                                        TIDEIN.16
        ZT(J)=ZB(J)                                                       TIDEIN.17
        TT(J)=TB(J)                                                       TIDEIN.18
        UT(J)=UB(J)                                                       TIDEIN.19
        VT(J)=VB(J)                                                       TIDEIN.20
       ENDDO                                                              TIDEIN.21
       DO I=1,LEN1                                                        TIDEIN.22
        BT(I)=BND(I)                                                      TIDEIN.23
       ENDDO                                                              TIDEIN.24
      ELSE IF(INDEX.EQ.1)THEN                                             TIDEIN.25
       DO J=1,JMAX                                                        TIDEIN.26
        ZT(J)=ZB2(J)                                                      TIDEIN.27
        TT(J)=TB2(J)                                                      TIDEIN.28
        UT(J)=UB2(J)                                                      TIDEIN.29
        VT(J)=VB2(J)                                                      TIDEIN.30
       ENDDO                                                              TIDEIN.31
       DO I=1,LEN1                                                        TIDEIN.32
        BT(I)=BND2(I)                                                     TIDEIN.33
       ENDDO                                                              TIDEIN.34
      ELSE                                                                TIDEIN.35
       DO J=1,JMAX                                                        TIDEIN.36
        ZT(J)=ZBA(J)                                                      TIDEIN.37
        TT(J)=TBA(J)                                                      TIDEIN.38
        UT(J)=UBA(J)                                                      TIDEIN.39
        VT(J)=VBA(J)                                                      TIDEIN.40
       ENDDO                                                              TIDEIN.41
       DO I=1,LEN1                                                        TIDEIN.42
        BT(I)=BNDA(I)                                                     TIDEIN.43
       ENDDO                                                              TIDEIN.44
      ENDIF                                                               TIDEIN.45
C     ****                                                                TIDEIN.46
C     ****     INTERPOLATE TIDE PERTURBATIONS IN THE LATITUDE             TIDEIN.47
C     ****     DIRECTION                                                  TIDEIN.48
C     ****                                                                TIDEIN.49
      RATIO=NESTRI(LEVEL)                                                 TIDEIN.50
      DO J=1,JNX                                                          TIDEIN.51
       IF(J.EQ.1)THEN                                                     TIDEIN.52
        JJ=NESTJ1(LEVEL)+J-1                                              TIDEIN.53
        ZP(J)=ZT(JJ)                                                      TIDEIN.54
        TP(J)=TT(JJ)                                                      TIDEIN.55
        UP(J)=UT(JJ)                                                      TIDEIN.56
        VP(J)=VT(JJ)                                                      TIDEIN.57
       ELSE                                                               TIDEIN.58
        J2=NESTRI(LEVEL)*(J-1)+1                                          TIDEIN.59
        J1=NESTRI(LEVEL)*(J-2)+1                                          TIDEIN.60
        JJ=NESTJ1(LEVEL)+J-1                                              TIDEIN.61
        ZP(J2)=ZT(JJ)                                                     TIDEIN.62
        TP(J2)=TT(JJ)                                                     TIDEIN.63
        UP(J2)=UT(JJ)                                                     TIDEIN.64
        VP(J2)=VT(JJ)                                                     TIDEIN.65
        DO L=1,NESTRI(LEVEL)-1                                            TIDEIN.66
         ZP(J2-L)=ZP(J2)-DBLE(L)*(ZP(J2)-ZP(J1))/RATIO                    TIDEIN.67
         TP(J2-L)=TP(J2)-DBLE(L)*(TP(J2)-TP(J1))/RATIO                    TIDEIN.68
         UP(J2-L)=UP(J2)-DBLE(L)*(UP(J2)-UP(J1))/RATIO                    TIDEIN.69
         VP(J2-L)=VP(J2)-DBLE(L)*(VP(J2)-VP(J1))/RATIO                    TIDEIN.70
        ENDDO                                                             TIDEIN.71
       ENDIF                                                              TIDEIN.72
      ENDDO                                                               TIDEIN.73
C     ****                                                                TIDEIN.74
C     ****     INTERPOLATE TIDE PERTURBATIONS IN THE LONGITUDE            TIDEIN.75
C     ****     DIRECTION                                                  TIDEIN.76
C     ****                                                                TIDEIN.77
      DO I=1,INX                                                          TIDEIN.78
       IF(I.EQ.1)THEN                                                     TIDEIN.79
        II=NESTI1(LEVEL)+I-1                                              TIDEIN.80
        BP(I)=BT(II)                                                      TIDEIN.81
       ELSE                                                               TIDEIN.82
        I2=NESTRI(LEVEL)*(I-1)+1                                          TIDEIN.83
        I1=NESTRI(LEVEL)*(I-2)+1                                          TIDEIN.84
        II=NESTI1(LEVEL)+I-1                                              TIDEIN.85
        BP(I2)=BT(II)                                                     TIDEIN.86
        DO L=1,NESTRI(LEVEL)-1                                            TIDEIN.87
         BP(I2-L)=BP(I2)-DBLE(L)*(BP(I2)-BP(I1))/RATIO                    TIDEIN.88
        ENDDO                                                             TIDEIN.89
       ENDIF                                                              TIDEIN.90
      ENDDO                                                               TIDEIN.91   
      RETURN                                                              TIDEIN.92
      END                                                                 TIDEIN.93
C                                                                         TIDEIN.94